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 ;; Exercise 3.66. Examine the stream (pairs integers integers). Can you make any general comments about the order in which the pairs are placed into the stream? For example, about how many pairs precede the pair (1,100)? the pair (99,100)? the pair (100,100)? (If you can make precise mathematical statements here, all the better. But feel free to give more qualitative answers if you find yourself getting bogged down.)
289 ;; (define the-pairs (pairs integers integers))
290 ;; (test-stream-list the-pairs
291 ;; '((1 1) (1 2) (2 2) (1 3) (2 3) (1 4) (3 3) (1 5) (2 4) (1 6) (3 4) (1 7) (2 5) (1 8) (4 4)))
293 ;; 2(j-1) for the pair (1, j) for j > 1
294 ;; 2(2(j-2))+1 for the pair (2, j) for j > 1
295 ;; 2(2(2(j-3)))+3 for the pair (3, j) for j > 1
296 ;; 2(2(2(2(j-4))))+7 for the pair (4, j) for j > 1
297 ;; 2(2(2(2(2(j-5)))))+15
299 ;; So, in general, (2^i)(j-i)+[summation of 2^(x-2)] from x = 2 to x = i
301 ;; (1, 100) will appear as term 2(100-1) = 198
302 ;; (test-case (stream-ref the-pairs 197) '(1 100))
303 ;; (display-streams 100 the-pairs integers)
305 (define double-summation (partial-sums double))
307 ;; (stream-ref double-summation 97)
309 ;; (stream-ref double-summation 98)
311 ;; Exercise 3.67. Modify the pairs procedure so that (pairs integers integers) will produce the stream of all pairs of integers (i,j) (without the condition i < j). Hint: You will need to mix in an additional stream.
313 (define (all-pairs s t)
315 (list (stream-car s) (stream-car t))
319 (list x (stream-car t)))
324 (list (stream-car s) x))
326 (all-pairs (stream-cdr s) (stream-cdr t))))))
329 (all-pairs integers integers)
330 '((1 1) (2 1) (1 2) (3 1) (2 2) (4 1) (1 3) (5 1) (3 2)))
