Vectors
histogram, from discussion, not tested
histogram, from discussion, not tested
;create new vect
with length max+1. Initialize to 0 (make-vector). Loop through score vect
(define (historgram
score-vect)
(let* ((size (+ 1 (vector-max score-vect)))
(hist-vect (make-vector size 0)))
(define (increment v j)
(vector-set! v j (+ 1
(vector-ref v j))))
(define (helper i)
(if (= i (vector-length
score-vect)
hist-vect
(begin
;increment the score
(increment hist-vect (vector-ref
score-vect i))
(helper (+ i 1)))))
(helper 0)))
VECTOR-APPEND, from
HW 6a
(define
(vector-append vec1 vec2)
(define (loop newvec vec n i)
(if (>= n 0)
(begin (vector-set! newvec i
(vector-ref vec n))
(loop newvec vec (- n 1) (- i 1)))))
(let ((result (make-vector
(+ (vector-length vec1) (vector-length vec2)))))
(loop result vec1
(- (vector-length vec1) 1) (- (vector-length vec1) 1))
(loop result vec2
(- (vector-length vec2) 1) (- (vector-length result) 1))
result))
VECTOR-FILTER, from
HW 6a
(define (vector-filter pred vec)
(define (get-length n)
(cond ((< n 0) 0)
((pred (vector-ref vec n))
(+ 1 (get-length (- n 1))))
(else (get-length (- n 1)))))
(define (loop newvec n i)
(cond ((< n 0) newvec)
((pred (vector-ref vec n))
(vector-set! newvec i (vector-ref vec n))
(loop newvec (- n 1) (- i 1)))
(else (loop newvec (- n 1) i))))
(let ((newlen (get-length (- (vector-length
vec) 1))))
(loop (make-vector newlen) (-
(vector-length vec) 1) (- newlen 1))))
Bubble sort, from HW
6a
(define
(bubble-sort! vec)
(let ((len (vector-length vec)))
(define (loop n)
(define (bubble k)
(if (= k n)
'one-pass-done
(let
((left (vector-ref vec (- k 1)))
(right (vector-ref vec k)))
(if (> left right)
(begin (vector-set! vec (- k 1) right)
(vector-set! vec k left)))
(bubble (+ k 1)))))
(if (< n 2)
vec
(begin (bubble 1)
(loop (- n 1)))))
(loop len)))
vector-lookup,
review solution
(define
(vector-lookup key)
(define (iter index)
(cond ((< index 0) #f)
((eq? key (vector-ref v-keys index))
(vector-ref
v-values index))
(else
(iter (- index
1)))))
(iter (- (vector-length v-keys) 1)))
vector-swap
(define
(vector-swap! v i j)
(let ((temp (vector-ref v i)))
(vector-set! v i (vector-ref v j))
(vector-set! v j temp)))
(define
(vector-reverse! v)
(define (iter i j)
(if (>= i j)
v
(begin (vector-swap! v i j)
(iter (+ i 1) (- j 1)))))
(iter 0 (- (vector-length v) 1)))
Additional Vector
Functions
(make-vector 4 0)
==> #(0 0 0 0)
(vector 1 2 3 5 8)
==> #(1 2 3 5 8)
Stream
1. (delay
<exp>) is (lambda () <exp>) or (memo-proc (lambda () <exp>))
2. (define (force
delayed-object)
(delayed-object))
3. (define
(stream-car stream) (car stream))
4. (define
(stream-cdr stream) (force (cdr stream)))
5. (define (sieve
stream)
(cons-stream
(stream-car stream)
(sieve (stream-filter
(lambda (x)
(not (divisible? x (stream-car
stream))))
(stream-cdr stream)))))
5. (define integers
(cons-stream 1 (add-streams ones integers))) ;stream of ints
6. (define
(add-streams s1 s2) ;adding s1 + s2
(stream-map + s1 s2))
7. (define
(scale-stream stream factor) ; a * s1
(stream-map (lambda (x) (* x factor))
stream))
8. (define double
(cons-stream 1 (scale-stream double 2))) ;s1^2
9. (define primes
;primes
(cons-stream
2
(stream-filter prime?
(integers-starting-from 3))))
(define (prime? n)
(define (iter ps)
(cond ((> (square (stream-car ps)) n)
true)
((divisible? n (stream-car ps))
false)
(else (iter (stream-cdr ps)))))
(iter primes))
10. (define
(integral integrand initial-value dt) ;integral
(define int
(cons-stream initial-value
(add-streams (scale-stream
integrand dt)
int)))
int)
11. (define
(stream-filter pred stream)
(cond ((stream-null? stream)
the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred
(stream-cdr stream))))
(else (stream-filter pred (stream-cdr
stream)))))
12. (define (prime?
n)
(stream-null? (stream-filter
(lambda (x) (= (remainder n x) 0))
(stream-enumerate-interval
2 (- n 1)))))
13. Definitions
(cons-stream a b) is
equivalent to (cons a (delay b))
(delay b) really
just means (lambda () b)
(define (force
promise) (promise))
(define (stream-car stream) (car stream))
(define (stream-cdr
stream) (force (cdr stream)))
14.
(define
(enumerate-interval from to)
(if (> from to)
’()
(cons from
(enumerate-interval (+ from 1) to)) ))
When we change this
to a stream function, we change very little in the appearance of the program:
(define
(stream-enumerate-interval from to)
(if (> from to)
THE-EMPTY-STREAM
(cons-STREAM from
(stream-enumerate-interval (+ from 1) to)) ))
15. pairs, Brian Harvey
note
(define (pairs s t)
(cons-stream
(list (stream-car s)
(stream-car t))
(interleave
(stream-map (lambda
(x) (list (stream-car s) x))
(stream-cdr t))
(pairs (stream-cdr s) (stream-cdr t))))) e
16.
(define (hanoi-stream n)
(if (= n 0)
the-empty-stream
(stream-append (hanoi-stream
(- n 1))
(cons-stream n (hanoi-stream (- n
1))))))
(hanoi-stream 1) (1)
(hanoi-stream 2) (1 2 1)
(hanoi-stream 3) (1 2 1 3 1 2
1)
(hanoi-stream 4) (1 2 1 3 1 2
1 4 1 2 1 3 1 2 1)
(define (nth-hanoi-element n)
(stream-nth n (hanoi-stream n)))
(define (stream-nth n stream)
(if (= n 1)
(stream-car stream)
(stream-nth (- n 1)
(stream-cdr stream))))
(define hanoi
(stream-map nth-hanoi-element integers))
(define (hanoi-number n)
(if (odd? n)
1
(+ 1 (hanoi-number (/ n 2)))))
(define hanoi
(stream-map hanoi-number integers))
(define (right-part n)
(cons-stream n
(stream-append (hanoi-stream (- n 1))
(right-part (+ n 1)))))
(define hanoi
(right-part 1))
(define (n-stream n)
(cons-stream n (n-stream n)))
(define hanoi
(cons-stream 1
(interleave (stream-map
+ hanoi ones) ones)))
Mutation
Invert, Mutation,
from Discussion, not tested
(define (invert! alist)
(cond
((null? alist) '())
(else
;first element
(let ((old-car (caar alist)))
(set-car! (car alist) (cdar alist))
(set-cdr! (car alist) old-car))
(invert! (cdr alist)))))
make-alist!
(1 2 3 4 5 6) è((1.2) (3.4) (5.6))
(define (make-alist! lst)
(if (null? lst)
'done
(let ((car1 (car lst))
(cdr1 (cdr lst))
(car2 (cadr lst))
(cdr2 (cddr lst)))
(set-car! lst cdr1)
(set-cdr! lst cdr2)
(set-car! cdr1 car1)
(set-cdr! cdr1 car2)
(make-alist! cdr2))))
list-rotate
> (list - rotate ! 3 ( list ’a ’b ’c ’d ’e
’f ’g))
(d e f g a b c)
(define (make-alist!
lst)
(if (null? lst)
'done
(let ((tmp (cddr lst)))
(set-cdr! (cdr lst) (cadr lst))
(set-car! (cdr lst) (car lst))
(set-car! lst (cdr lst))
(set-cdr! lst tmp)
(make-alist! tmp))))
deep-fix! 1997 mt3
(define (deep-fix! p)
(cond ((pair? p)
(set-car! p
(deep-fix! (car p)))
(set-cdr! p (if
(pair? (cdr p))
(deep-fix! (cdr p))
'()))
p)
(else p)))
rotate! 2006 mt3
(define (rotate! node)
(let ((a (left-branch node))
(b (datum node))
(c (left-branch (right-branch node)))
(d (datum (right-branch node)))
(e (right-branch (right-branch node)))
(rb (right-branch node)))
(set-left-branch! rb a)
(set-datum! rb b)
(set-right-branch! rb c)
(set-left-branch! node rb)
(set-datum! node d)
(set-right-branch! node e)))
ssort, 2006 print
midterm 3
(define (ssort! vec)
(define (help start)
(if (= start (length vec))
vec
(let ((smallest (subvec-min-start vec start)))
(let ((temp
(vector-ref vec smallest)))
(vector-set! vec
smallest (vector-ref vec start))
(vector-set!
vec start temp)
(help (+ start
1))))))
(help 0))
Tree, depth first, breath first, 1998 final
(define (bfs tree pred)
(define (helper
tasks)
(cond ((null?
tasks) #f)
((pred (datum (car tasks))) (datum (car
tasks)))
(else (helper (append (CDR TASKS) (CHILDREN
(CAR TASKS)))))))
(helper (list
tree))) ; ----------- ----------------------
(define (dfs tree
pred)
(define (helper
tasks)
(cond ((null?
tasks) #f)
((pred (datum (car tasks))) (datum (car
tasks)))
(else (helper (append (CHILDREN (CAR TASKS))
(CDR TASKS))))))
(helper (list
tree))) ; ---------------------- -----------
auto-selectors, 1998 final
(a) (define binary-tree '(datum left-branch
right-branch))
(define (select field type)
(lambda (thing)
(if (eq? field
(car type))
(car
thing)
((select
field (cdr type)) (cdr thing)))))
No comments:
Post a Comment