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))
89 (cons-stream a (fibgen b (+ a b))))
90 (define fibs (fibgen 0 1))
97 (not (divisible? x (stream-car s))))
100 (define ones (cons-stream 1 ones))
101 (define (add-streams s1 s2)
102 (stream-map + s1 s2))
103 (define integers (cons-stream 1 (add-streams ones integers)))
108 (add-streams (stream-cdr fibs)
111 (define (scale-stream stream factor)
112 (stream-map (lambda (x)
119 (stream-filter prime? (integers-starting-from 3))))
122 (cond ((> (square (stream-car ps)) n) true)
123 ((divisible? n (stream-car ps)) false)
124 (else (iter (stream-cdr ps)))))
127 (define (mul-streams s1 s2)
128 (stream-map * s1 s2))
130 (define (partial-sums s)
132 (cons-stream (stream-car s)
137 (define (merge s1 s2)
138 (cond ((stream-null? s1) s2)
139 ((stream-null? s2) s1)
141 (let ((s1car (stream-car s1))
142 (s2car (stream-car s2)))
143 (cond ((< s1car s2car)
146 (merge (stream-cdr s1) s2)))
150 (merge s1 (stream-cdr s2))))
154 (merge (stream-cdr s1) (stream-cdr s2)))))))))
156 (define (test-stream-list stream list)
159 (begin (display "A: ")
160 (display (stream-car stream))
165 (test-stream-list (stream-cdr stream) (cdr list)))))
167 (define (integrate-series a)
168 (stream-map / a integers))
171 (cons-stream 1 (integrate-series exp-series)))
173 (define cosine-series
176 (integrate-series (stream-map - sine-series))))
180 (integrate-series cosine-series)))
182 (define (mul-series s1 s2)
184 (* (stream-car s1) (stream-car s2))
186 (scale-stream (stream-cdr s2) (stream-car s1))
187 (mul-series (stream-cdr s1) s2))))
189 (define (invert-unit-series s)
193 (mul-series (stream-map - (stream-cdr s))
197 (define (div-series num den)
198 (let ((den-car (stream-car den)))
200 (error "Denominator has zero constant term -- DIV-SERIES")
204 (invert-unit-series (scale-stream den (/ 1 den-car))))
208 (define (sqrt-improve guess x)
209 (define (average x y)
211 (average guess (/ x guess)))
213 (define (sqrt-stream x)
217 (stream-map (lambda (guess)
218 (sqrt-improve guess x))
222 (define (pi-summands n)
224 (stream-map - (pi-summands (+ n 2)))))
226 (scale-stream (partial-sums (pi-summands 1)) 4))
228 (define (euler-transform s)
229 (let ((s0 (stream-ref s 0))
230 (s1 (stream-ref s 1))
231 (s2 (stream-ref s 2)))
233 (- s2 (/ (square (- s2 s1))
234 (+ s0 (* -2 s1) s2)))
235 (euler-transform (stream-cdr s)))))
237 (define (make-tableau transform s)
239 (make-tableau transform
242 (define (stream-limit s tol)
243 (let* ((scar (stream-car s))
244 (scdr (stream-cdr s))
245 (scadr (stream-car scdr)))
246 (if (< (abs (- scar scadr)) tol)
248 (stream-limit scdr tol))))
250 (define (sqrt x tolerance)
251 (stream-limit (sqrt-stream x) tolerance))
255 (list (stream-car s) (stream-car t))
259 (list (stream-car s) x))
261 (pairs (stream-cdr s) (stream-cdr t)))))
262 (define (interleave s1 s2)
263 (if (stream-null? s1)
265 (cons-stream (stream-car s1)
266 (interleave s2 (stream-cdr s1)))))
268 (define (display-streams n . streams)
273 (display (stream-car s))
276 (apply display-streams
277 (cons (- n 1) (map stream-cdr streams))))))
279 (define (all-pairs s t)
281 (list (stream-car s) (stream-car t))
285 (list x (stream-car t)))
290 (list (stream-car s) x))
292 (all-pairs (stream-cdr s) (stream-cdr t))))))
294 (define (triples s t u)
296 (list (stream-car s) (stream-car t) (stream-car u))
298 (stream-cdr (stream-map (lambda (pair)
299 (cons (stream-car s) pair))
301 (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
303 (define pythag-triples
306 (let ((i (car triple))
309 (= (square k) (+ (square i) (square j)))))
310 (triples integers integers integers)))
312 (define (merge-weighted s1 s2 weight)
313 (cond ((stream-null? s1) s2)
314 ((stream-null? s2) s1)
316 (let ((s1car (stream-car s1))
317 (s2car (stream-car s2)))
318 (if (<= (weight s1car) (weight s2car))
321 (merge-weighted (stream-cdr s1) s2 weight))
324 (merge-weighted s1 (stream-cdr s2) weight)))))))
326 (define (weighted-pairs s t weight)
328 (list (stream-car s) (stream-car t))
332 (list (stream-car s) x))
334 (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
337 (define (integral integrand initial-value dt)
339 (cons-stream initial-value
340 (add-streams (scale-stream integrand dt)
344 (define (list->stream list)
347 (cons-stream (car list)
348 (list->stream (cdr list)))))
352 (cons-stream initial-value
353 (add-streas (scale-stream integrand dt)
