(load "util.scm") (display "\nex-3.50 - stream-map\n") (define (stream-enumerate-interval low high) (if (> low high) the-empty-stream (cons-stream low (stream-enumerate-interval (+ low 1) high)))) (define (stream-map proc . argstreams) (if (stream-null? (car argstreams)) the-empty-stream (cons-stream (apply proc (map stream-car argstreams)) (apply stream-map (cons proc (map stream-cdr argstreams)))))) (define (stream-to-list xs) (if (stream-null? xs) '() (cons (stream-car xs) (stream-to-list (stream-cdr xs))))) (assert (stream-to-list (stream-enumerate-interval 1 3)) '(1 2 3)) (assert (stream-to-list (stream-map (lambda (x y) (* x y)) (stream-enumerate-interval 1 3) (stream-enumerate-interval -3 -1))) '(-3 -4 -3)) (display "\nex-3.51\n") (define (show x) (display-line x) x) (define (stream-ref s n) (if (= n 0) (stream-car s) (stream-ref (stream-cdr s) (- n 1)))) (define x (stream-map show (stream-enumerate-interval 0 10))) (stream-ref x 5) ; 0 ; 1 ; 2 ; 3 ; 4 ; 5 (stream-ref x 7) ; 6 ; 7 (display "\nex-3.52\n") (define (display-stream s) (stream-for-each display-line s)) (define sum 0) (define (accum x) (set! sum (+ x sum)) sum) (define seq (stream-map accum (stream-enumerate-interval 1 20))) ; 1 3 6 10 15 21 28 36 45 55 66 78 91 105 120 136 153 171 190 210 (define y (stream-filter even? seq)) ; 6 10 28 36 66 78 120 136 190 210 (define z (stream-filter (lambda (x) (= (remainder x 5) 0)) seq)) (assert (stream-ref y 7) 136) (assert (stream-to-list z) '(10 15 45 55 105 120 190 210)) ; The responses would differ if we had implemented delay without memo-proc, ; because the values of the stream would be recomputed for z starting from the ; last value of sum after defining y. (display "\nexample - sieve of Eratosthenes\n") (define (integers-starting-from n) (cons-stream n (integers-starting-from (+ n 1)))) (define (divisible? x y) (= (remainder x y) 0)) (define (sieve stream) (cons-stream (stream-car stream) (sieve (stream-filter (lambda (x) (not (divisible? x (stream-car stream)))) (stream-cdr stream))))) (define primes (sieve (integers-starting-from 2))) (assert (stream-ref primes 5) 13) (display "\nex-3.53\n") (define (add-streams s1 s2) (stream-map + s1 s2)) (define ones (cons-stream 1 ones)) (define integers (cons-stream 1 (add-streams ones integers))) (define (take n xs) (if (= n 0) '() (cons (stream-car xs) (take (- n 1) (stream-cdr xs))))) (assert (take 3 integers) '(1 2 3)) (define fibs (cons-stream 0 (cons-stream 1 (add-streams (stream-cdr fibs) fibs)))) (assert (take 7 fibs) '(0 1 1 2 3 5 8)) (define (scale-stream stream factor) (stream-map (lambda (x) (* x factor)) stream)) (define double (cons-stream 1 (scale-stream double 2))) (assert (take 3 double) '(1 2 4)) (define s (cons-stream 1 (add-streams s s))) (assert (take 5 s) '(1 2 4 8 16)) (display "\nex-3.54 - factorials\n") (define (mul-streams s1 s2) (stream-map * s1 s2)) (define factorials (cons-stream 1 (mul-streams (stream-cdr integers) factorials))) (assert (take 5 factorials) '(1 2 6 24 120)) (display "\nex-3.55 - partial-sums\n") (define (partial-sums xs) (cons-stream (stream-car xs) (add-streams (partial-sums xs) (stream-cdr xs)))) (assert (take 5 (partial-sums integers)) '(1 3 6 10 15)) (display "\nex-3.56 - enumerate multiplies of 2, 3, 5\n") (define (merge s1 s2) (cond ((stream-null? s1) s2) ((stream-null? s2) s1) (else (let ((s1car (stream-car s1)) (s2car (stream-car s2))) (cond ((< s1car s2car) (cons-stream s1car (merge (stream-cdr s1) s2))) ((> s1car s2car) (cons-stream s2car (merge s1 (stream-cdr s2)))) (else (cons-stream s1car (merge (stream-cdr s1) (stream-cdr s2))))))))) (define S (cons-stream 1 (merge (merge (scale-stream S 2) (scale-stream S 3)) (scale-stream S 5)))) (assert (take 10 S) '(1 2 3 4 5 6 8 9 10 12)) (display "\nex-3.57\n")