(load "shared/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 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 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 ones (cons-stream 1 ones)) (define integers (cons-stream 1 (add-streams ones integers))) (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 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") (display "[answered]\n") ; With memoizing only one addition is required per number. So the complexity is ; O(n). With memoizing the previous numbers have to be calculated recursively ; which leads to exponential growth. (display "\nex-3.58 - expand\n") (define (expand num den radix) (cons-stream (quotient (* num radix) den) (expand (remainder (* num radix) den) den radix))) (assert (take 5 (expand 1 7 10)) '(1 4 2 8 5)) (assert (take 5 (expand 3 8 10)) '(3 7 5 0 0)) ; The procedure expands a fraction (num/dem) into the rational value to base ; radix. (display "\nex-3.59 - sine/cosine series\n") (define (integrate-series xs) (define (iter n xs) (cons-stream (* (/ 1 n) (stream-car xs)) (iter (+ n 1) (stream-cdr xs)))) (iter 1 xs)) (define (integrate-series xs) (stream-map * (stream-map / ones integers) xs)) (assert (take 5 (integrate-series integers)) '(1 1 1 1 1)) (define exp-series (cons-stream 1 (integrate-series exp-series))) (define (sum xs) (if (null? xs) 0 (+ (car xs) (sum (cdr xs))))) (assert (sum (take 5 exp-series)) (/ 65 24)) (define cosine-series (cons-stream 1 (stream-map - (integrate-series sine-series)))) (define sine-series (cons-stream 0 (integrate-series cosine-series))) (assert (sum (take 10 sine-series)) (/ 305353 362880)) (display "\nex-3.60 - mul-series\n") (define add-series add-streams) (define (mul-series s1 s2) (cons-stream (* (stream-car s1) (stream-car s2)) (add-streams (scale-stream (stream-cdr s2) (stream-car s1)) (mul-series (stream-cdr s1) s2))))) (assert (sum (take 10 (add-series (mul-series cosine-series cosine-series) (mul-series sine-series sine-series)))) 1) (display "\nex-3.61 - invert-unit-series\n") (define (invert-unit-series s) (cons-stream 1 (mul-series (stream-map - (stream-cdr s)) (invert-unit-series s)))) (define X (invert-unit-series cosine-series)) (assert (sum (take 10 (mul-series cosine-series X))) 1) (display "\nex-3.62 - tan\n") (define (div-series ns ds) (if (= (stream-car ds) 0) (error "denominator is zero -- DIV-SERIES" ds) (mul-series ns (invert-unit-series ds)))) (define tan-series (div-series sine-series cosine-series)) (assert (< (abs (- (exact->inexact (sum (take 20 (div-series sine-series cosine-series)))) 1.5574)) 0.001) #t)