1 (define (memo-proc proc)
2 (let ((already-run? false) (result false))
6 (begin (set! already-run? true)
10 (define-syntax mydelay
11 (rsc-macro-transformer
14 `(memo-proc (lambda () ,exp)))))
16 (apply xfmr (cdr e))))))
18 (define (myforce delayed-object)
21 (define-syntax cons-stream
22 (rsc-macro-transformer
23 (let ((xfmr (lambda (x y) `(cons ,x (mydelay ,y)))))
25 (apply xfmr (cdr e))))))
27 (define (stream-car s)
29 (define (stream-cdr s)
31 (define stream-null? null?)
32 (define the-empty-stream '())
34 (define (integers-starting-from n)
35 (cons-stream n (integers-starting-from (+ n 1))))
37 (define (stream-ref s n)
40 (stream-ref (stream-cdr s) (- n 1))))
41 (define (stream-map proc . argstreams)
42 (if (stream-null? (car argstreams))
45 (apply proc (map stream-car argstreams))
46 (apply stream-map (cons proc (map stream-cdr argstreams))))))
47 (define (stream-for-each proc s)
50 (begin (proc (stream-car s))
51 (stream-for-each proc (stream-cdr s)))))
53 (define (stream-enumerate-interval low high)
58 (stream-enumerate-interval (+ low 1) high))))
59 (define (stream-filter pred s)
62 (let ((scar (stream-car s)))
64 (cons-stream scar (stream-filter pred (stream-cdr s)))
65 (stream-filter pred (stream-cdr s))))))
67 (define (display-stream s)
68 (stream-for-each display-line s))
69 (define (display-line x)
73 (define (test-case actual expected)
78 (display "Expected: ")
82 (define (integers-starting-from n)
83 (cons-stream n (integers-starting-from (+ n 1))))
84 (define integers (integers-starting-from 1))
86 (define (divisible? x y) (= (remainder x y) 0))
88 (stream-filter (lambda (x) (not (divisible? x 7)))
92 (cons-stream a (fibgen b (+ a b))))
93 (define fibs (fibgen 0 1))
100 (not (divisible? x (stream-car s))))
103 ;; (define primes (sieve (integers-starting-from 2)))
104 ;; (test-case (stream-ref primes 25) 101)
106 (define ones (cons-stream 1 ones))
107 (define (add-streams s1 s2)
108 (stream-map + s1 s2))
109 (define integers (cons-stream 1 (add-streams ones integers)))
110 ;; (test-case (stream-ref integers 15) 16)
115 (add-streams (stream-cdr fibs)
118 (define (scale-stream stream factor)
119 (stream-map (lambda (x)
122 (define double (cons-stream 1 (scale-stream double 2)))
127 (stream-filter prime? (integers-starting-from 3))))
130 (cond ((> (square (stream-car ps)) n) true)
131 ((divisible? n (stream-car ps)) false)
132 (else (iter (stream-cdr ps)))))
135 (define (mul-streams s1 s2)
136 (stream-map * s1 s2))
138 (define (partial-sums s)
140 (cons-stream (stream-car s)
145 (define (merge s1 s2)
146 (cond ((stream-null? s1) s2)
147 ((stream-null? s2) s1)
149 (let ((s1car (stream-car s1))
150 (s2car (stream-car s2)))
151 (cond ((< s1car s2car)
154 (merge (stream-cdr s1) s2)))
158 (merge s1 (stream-cdr s2))))
162 (merge (stream-cdr s1) (stream-cdr s2)))))))))
164 (define (test-stream-list stream list)
167 (begin (display "A: ")
168 (display (stream-car stream))
173 (test-stream-list (stream-cdr stream) (cdr list)))))
175 (define (integrate-series a)
176 (stream-map / a integers))
179 (cons-stream 1 (integrate-series exp-series)))
181 (define cosine-series
184 (integrate-series (stream-map - sine-series))))
188 (integrate-series cosine-series)))
190 (define (mul-series s1 s2)
192 (* (stream-car s1) (stream-car s2))
194 (scale-stream (stream-cdr s2) (stream-car s1))
195 (mul-series (stream-cdr s1) s2))))
197 (define (invert-unit-series s)
201 (mul-series (stream-map - (stream-cdr s))
205 (define (div-series num den)
206 (let ((den-car (stream-car den)))
208 (error "Denominator has zero constant term -- DIV-SERIES")
212 (invert-unit-series (scale-stream den (/ 1 den-car))))
216 (define (sqrt-improve guess x)
217 (define (average x y)
219 (average guess (/ x guess)))
221 (define (sqrt-stream x)
225 (stream-map (lambda (guess)
226 (sqrt-improve guess x))
230 (define (pi-summands n)
232 (stream-map - (pi-summands (+ n 2)))))
234 (scale-stream (partial-sums (pi-summands 1)) 4))
236 (define (euler-transform s)
237 (let ((s0 (stream-ref s 0))
238 (s1 (stream-ref s 1))
239 (s2 (stream-ref s 2)))
241 (- s2 (/ (square (- s2 s1))
242 (+ s0 (* -2 s1) s2)))
243 (euler-transform (stream-cdr s)))))
245 (define (make-tableau transform s)
247 (make-tableau transform
250 (define (stream-limit s tol)
251 (let* ((scar (stream-car s))
252 (scdr (stream-cdr s))
253 (scadr (stream-car scdr)))
254 (if (< (abs (- scar scadr)) tol)
256 (stream-limit scdr tol))))
258 (define (sqrt x tolerance)
259 (stream-limit (sqrt-stream x) tolerance))
263 (list (stream-car s) (stream-car t))
267 (list (stream-car s) x))
269 (pairs (stream-cdr s) (stream-cdr t)))))
270 (define (interleave s1 s2)
271 (if (stream-null? s1)
273 (cons-stream (stream-car s1)
274 (interleave s2 (stream-cdr s1)))))
276 (define (display-streams n . streams)
281 (display (stream-car s))
284 (apply display-streams
285 (cons (- n 1) (map stream-cdr streams))))))
287 (define (all-pairs s t)
289 (list (stream-car s) (stream-car t))
293 (list x (stream-car t)))
298 (list (stream-car s) x))
300 (all-pairs (stream-cdr s) (stream-cdr t))))))
302 ;; Exercise 3.69. Write a procedure triples that takes three infinite streams, S, T, and U, and produces the stream of triples (Si,Tj,Uk) such that i < j < k. Use triples to generate the stream of all Pythagorean triples of positive integers, i.e., the triples (i,j,k) such that i < j and i2 + j2 = k2.
312 (define (triples s t u)
314 (list (stream-car s) (stream-car t) (stream-car u))
316 (stream-cdr (stream-map (lambda (pair)
317 (cons (stream-car s) pair))
319 (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
321 (define pythag-triples
324 (let ((i (car triple))
327 (= (square k) (+ (square i) (square j)))))
328 (triples integers integers integers)))
330 (display-streams 20 pythag-triples)
