1 665c255d 2023-08-04 jrmu (define (memo-proc proc)
2 665c255d 2023-08-04 jrmu (let ((already-run? false) (result false))
4 665c255d 2023-08-04 jrmu (if already-run?
6 665c255d 2023-08-04 jrmu (begin (set! already-run? true)
7 665c255d 2023-08-04 jrmu (set! result (proc))
10 665c255d 2023-08-04 jrmu (define-syntax mydelay
11 665c255d 2023-08-04 jrmu (rsc-macro-transformer
13 665c255d 2023-08-04 jrmu (lambda (exp)
14 665c255d 2023-08-04 jrmu `(memo-proc (lambda () ,exp)))))
15 665c255d 2023-08-04 jrmu (lambda (e r)
16 665c255d 2023-08-04 jrmu (apply xfmr (cdr e))))))
18 665c255d 2023-08-04 jrmu (define (myforce delayed-object)
19 665c255d 2023-08-04 jrmu (delayed-object))
21 665c255d 2023-08-04 jrmu (define-syntax cons-stream
22 665c255d 2023-08-04 jrmu (rsc-macro-transformer
23 665c255d 2023-08-04 jrmu (let ((xfmr (lambda (x y) `(cons ,x (mydelay ,y)))))
24 665c255d 2023-08-04 jrmu (lambda (e r)
25 665c255d 2023-08-04 jrmu (apply xfmr (cdr e))))))
27 665c255d 2023-08-04 jrmu (define (stream-car s)
29 665c255d 2023-08-04 jrmu (define (stream-cdr s)
30 665c255d 2023-08-04 jrmu (myforce (cdr s)))
31 665c255d 2023-08-04 jrmu (define stream-null? null?)
32 665c255d 2023-08-04 jrmu (define the-empty-stream '())
34 665c255d 2023-08-04 jrmu (define (integers-starting-from n)
35 665c255d 2023-08-04 jrmu (cons-stream n (integers-starting-from (+ n 1))))
37 665c255d 2023-08-04 jrmu (define (stream-ref s n)
39 665c255d 2023-08-04 jrmu (stream-car s)
40 665c255d 2023-08-04 jrmu (stream-ref (stream-cdr s) (- n 1))))
41 665c255d 2023-08-04 jrmu (define (stream-map proc . argstreams)
42 665c255d 2023-08-04 jrmu (if (stream-null? (car argstreams))
43 665c255d 2023-08-04 jrmu the-empty-stream
44 665c255d 2023-08-04 jrmu (cons-stream
45 665c255d 2023-08-04 jrmu (apply proc (map stream-car argstreams))
46 665c255d 2023-08-04 jrmu (apply stream-map (cons proc (map stream-cdr argstreams))))))
47 665c255d 2023-08-04 jrmu (define (stream-for-each proc s)
48 665c255d 2023-08-04 jrmu (if (stream-null? s)
50 665c255d 2023-08-04 jrmu (begin (proc (stream-car s))
51 665c255d 2023-08-04 jrmu (stream-for-each proc (stream-cdr s)))))
53 665c255d 2023-08-04 jrmu (define (stream-enumerate-interval low high)
54 665c255d 2023-08-04 jrmu (if (> low high)
55 665c255d 2023-08-04 jrmu the-empty-stream
56 665c255d 2023-08-04 jrmu (cons-stream
58 665c255d 2023-08-04 jrmu (stream-enumerate-interval (+ low 1) high))))
59 665c255d 2023-08-04 jrmu (define (stream-filter pred s)
60 665c255d 2023-08-04 jrmu (if (stream-null? s)
61 665c255d 2023-08-04 jrmu the-empty-stream
62 665c255d 2023-08-04 jrmu (let ((scar (stream-car s)))
63 665c255d 2023-08-04 jrmu (if (pred scar)
64 665c255d 2023-08-04 jrmu (cons-stream scar (stream-filter pred (stream-cdr s)))
65 665c255d 2023-08-04 jrmu (stream-filter pred (stream-cdr s))))))
67 665c255d 2023-08-04 jrmu (define (display-stream s)
68 665c255d 2023-08-04 jrmu (stream-for-each display-line s))
69 665c255d 2023-08-04 jrmu (define (display-line x)
71 665c255d 2023-08-04 jrmu (display x))
73 665c255d 2023-08-04 jrmu (define (test-case actual expected)
75 665c255d 2023-08-04 jrmu (display "Actual: ")
76 665c255d 2023-08-04 jrmu (display actual)
78 665c255d 2023-08-04 jrmu (display "Expected: ")
79 665c255d 2023-08-04 jrmu (display expected)
82 665c255d 2023-08-04 jrmu (define (integers-starting-from n)
83 665c255d 2023-08-04 jrmu (cons-stream n (integers-starting-from (+ n 1))))
84 665c255d 2023-08-04 jrmu (define integers (integers-starting-from 1))
86 665c255d 2023-08-04 jrmu (define (divisible? x y) (= (remainder x y) 0))
87 665c255d 2023-08-04 jrmu (define no-sevens
88 665c255d 2023-08-04 jrmu (stream-filter (lambda (x) (not (divisible? x 7)))
91 665c255d 2023-08-04 jrmu (define (fibgen a b)
92 665c255d 2023-08-04 jrmu (cons-stream a (fibgen b (+ a b))))
93 665c255d 2023-08-04 jrmu (define fibs (fibgen 0 1))
95 665c255d 2023-08-04 jrmu (define (sieve s)
96 665c255d 2023-08-04 jrmu (cons-stream
97 665c255d 2023-08-04 jrmu (stream-car s)
98 665c255d 2023-08-04 jrmu (sieve (stream-filter
100 665c255d 2023-08-04 jrmu (not (divisible? x (stream-car s))))
101 665c255d 2023-08-04 jrmu (stream-cdr s)))))
103 665c255d 2023-08-04 jrmu ;; (define primes (sieve (integers-starting-from 2)))
104 665c255d 2023-08-04 jrmu ;; (test-case (stream-ref primes 25) 101)
106 665c255d 2023-08-04 jrmu (define ones (cons-stream 1 ones))
107 665c255d 2023-08-04 jrmu (define (add-streams s1 s2)
108 665c255d 2023-08-04 jrmu (stream-map + s1 s2))
109 665c255d 2023-08-04 jrmu (define integers (cons-stream 1 (add-streams ones integers)))
110 665c255d 2023-08-04 jrmu ;; (test-case (stream-ref integers 15) 16)
112 665c255d 2023-08-04 jrmu (define fibs
113 665c255d 2023-08-04 jrmu (cons-stream 0
114 665c255d 2023-08-04 jrmu (cons-stream 1
115 665c255d 2023-08-04 jrmu (add-streams (stream-cdr fibs)
118 665c255d 2023-08-04 jrmu (define (scale-stream stream factor)
119 665c255d 2023-08-04 jrmu (stream-map (lambda (x)
120 665c255d 2023-08-04 jrmu (* x factor))
122 665c255d 2023-08-04 jrmu (define double (cons-stream 1 (scale-stream double 2)))
124 665c255d 2023-08-04 jrmu (define primes
125 665c255d 2023-08-04 jrmu (cons-stream
127 665c255d 2023-08-04 jrmu (stream-filter prime? (integers-starting-from 3))))
128 665c255d 2023-08-04 jrmu (define (prime? n)
129 665c255d 2023-08-04 jrmu (define (iter ps)
130 665c255d 2023-08-04 jrmu (cond ((> (square (stream-car ps)) n) true)
131 665c255d 2023-08-04 jrmu ((divisible? n (stream-car ps)) false)
132 665c255d 2023-08-04 jrmu (else (iter (stream-cdr ps)))))
133 665c255d 2023-08-04 jrmu (iter primes))
135 665c255d 2023-08-04 jrmu (define (mul-streams s1 s2)
136 665c255d 2023-08-04 jrmu (stream-map * s1 s2))
138 665c255d 2023-08-04 jrmu (define (partial-sums s)
139 665c255d 2023-08-04 jrmu (define sums
140 665c255d 2023-08-04 jrmu (cons-stream (stream-car s)
141 665c255d 2023-08-04 jrmu (add-streams sums
142 665c255d 2023-08-04 jrmu (stream-cdr s))))
145 665c255d 2023-08-04 jrmu (define (merge s1 s2)
146 665c255d 2023-08-04 jrmu (cond ((stream-null? s1) s2)
147 665c255d 2023-08-04 jrmu ((stream-null? s2) s1)
149 665c255d 2023-08-04 jrmu (let ((s1car (stream-car s1))
150 665c255d 2023-08-04 jrmu (s2car (stream-car s2)))
151 665c255d 2023-08-04 jrmu (cond ((< s1car s2car)
152 665c255d 2023-08-04 jrmu (cons-stream
154 665c255d 2023-08-04 jrmu (merge (stream-cdr s1) s2)))
155 665c255d 2023-08-04 jrmu ((> s1car s2car)
156 665c255d 2023-08-04 jrmu (cons-stream
158 665c255d 2023-08-04 jrmu (merge s1 (stream-cdr s2))))
160 665c255d 2023-08-04 jrmu (cons-stream
162 665c255d 2023-08-04 jrmu (merge (stream-cdr s1) (stream-cdr s2)))))))))
164 665c255d 2023-08-04 jrmu (define (test-stream-list stream list)
165 665c255d 2023-08-04 jrmu (if (null? list)
167 665c255d 2023-08-04 jrmu (begin (display "A: ")
168 665c255d 2023-08-04 jrmu (display (stream-car stream))
169 665c255d 2023-08-04 jrmu (display " -- ")
170 665c255d 2023-08-04 jrmu (display "E: ")
171 665c255d 2023-08-04 jrmu (display (car list))
173 665c255d 2023-08-04 jrmu (test-stream-list (stream-cdr stream) (cdr list)))))
175 665c255d 2023-08-04 jrmu (define (integrate-series a)
176 665c255d 2023-08-04 jrmu (stream-map / a integers))
178 665c255d 2023-08-04 jrmu (define exp-series
179 665c255d 2023-08-04 jrmu (cons-stream 1 (integrate-series exp-series)))
181 665c255d 2023-08-04 jrmu (define cosine-series
182 665c255d 2023-08-04 jrmu (cons-stream
184 665c255d 2023-08-04 jrmu (integrate-series (stream-map - sine-series))))
185 665c255d 2023-08-04 jrmu (define sine-series
186 665c255d 2023-08-04 jrmu (cons-stream
188 665c255d 2023-08-04 jrmu (integrate-series cosine-series)))
190 665c255d 2023-08-04 jrmu (define (mul-series s1 s2)
191 665c255d 2023-08-04 jrmu (cons-stream
192 665c255d 2023-08-04 jrmu (* (stream-car s1) (stream-car s2))
193 665c255d 2023-08-04 jrmu (add-streams
194 665c255d 2023-08-04 jrmu (scale-stream (stream-cdr s2) (stream-car s1))
195 665c255d 2023-08-04 jrmu (mul-series (stream-cdr s1) s2))))
197 665c255d 2023-08-04 jrmu (define (invert-unit-series s)
199 665c255d 2023-08-04 jrmu (cons-stream
201 665c255d 2023-08-04 jrmu (mul-series (stream-map - (stream-cdr s))
205 665c255d 2023-08-04 jrmu (define (div-series num den)
206 665c255d 2023-08-04 jrmu (let ((den-car (stream-car den)))
207 665c255d 2023-08-04 jrmu (if (zero? den-car)
208 665c255d 2023-08-04 jrmu (error "Denominator has zero constant term -- DIV-SERIES")
209 665c255d 2023-08-04 jrmu (scale-stream
210 665c255d 2023-08-04 jrmu (mul-series
212 665c255d 2023-08-04 jrmu (invert-unit-series (scale-stream den (/ 1 den-car))))
213 665c255d 2023-08-04 jrmu (/ 1 den-car)))))
216 665c255d 2023-08-04 jrmu (define (sqrt-improve guess x)
217 665c255d 2023-08-04 jrmu (define (average x y)
218 665c255d 2023-08-04 jrmu (/ (+ x y) 2))
219 665c255d 2023-08-04 jrmu (average guess (/ x guess)))
221 665c255d 2023-08-04 jrmu (define (sqrt-stream x)
222 665c255d 2023-08-04 jrmu (define guesses
223 665c255d 2023-08-04 jrmu (cons-stream
225 665c255d 2023-08-04 jrmu (stream-map (lambda (guess)
226 665c255d 2023-08-04 jrmu (sqrt-improve guess x))
229 665c255d 2023-08-04 jrmu ;; (test-stream-list (stream-map exact->inexact (sqrt-stream 2))
230 665c255d 2023-08-04 jrmu ;; '(1 1.5 1.4166 1.4142156 1.41421356))
232 665c255d 2023-08-04 jrmu (define (pi-summands n)
233 665c255d 2023-08-04 jrmu (cons-stream (/ 1 n)
234 665c255d 2023-08-04 jrmu (stream-map - (pi-summands (+ n 2)))))
235 665c255d 2023-08-04 jrmu (define pi-stream
236 665c255d 2023-08-04 jrmu (scale-stream (partial-sums (pi-summands 1)) 4))
237 665c255d 2023-08-04 jrmu ;; (test-stream-list (stream-map exact->inexact pi-stream)
238 665c255d 2023-08-04 jrmu ;; '(4 2.6667 3.4667 2.8952 3.3397))
240 665c255d 2023-08-04 jrmu (define (euler-transform s)
241 665c255d 2023-08-04 jrmu (let ((s0 (stream-ref s 0))
242 665c255d 2023-08-04 jrmu (s1 (stream-ref s 1))
243 665c255d 2023-08-04 jrmu (s2 (stream-ref s 2)))
244 665c255d 2023-08-04 jrmu (cons-stream
245 665c255d 2023-08-04 jrmu (- s2 (/ (square (- s2 s1))
246 665c255d 2023-08-04 jrmu (+ s0 (* -2 s1) s2)))
247 665c255d 2023-08-04 jrmu (euler-transform (stream-cdr s)))))
249 665c255d 2023-08-04 jrmu ;; (test-stream-list (stream-map exact->inexact (euler-transform pi-stream))
250 665c255d 2023-08-04 jrmu ;; '(3.1667 3.1333 3.1452 3.1397 3.1427))
252 665c255d 2023-08-04 jrmu (define (make-tableau transform s)
253 665c255d 2023-08-04 jrmu (cons-stream s
254 665c255d 2023-08-04 jrmu (make-tableau transform
255 665c255d 2023-08-04 jrmu (transform s))))
257 665c255d 2023-08-04 jrmu ;; (test-stream-list (stream-map exact->inexact (stream-map stream-car (make-tableau euler-transform pi-stream)))
258 665c255d 2023-08-04 jrmu ;; '(4 3.1667 3.1421 3.1459935 3.1415927140 3.145926539752927))
260 665c255d 2023-08-04 jrmu ;; Exercise 3.63. Louis Reasoner asks why the sqrt-stream procedure was not written in the following more straightforward way, without the local variable guesses:
262 665c255d 2023-08-04 jrmu (define (sqrt-stream x)
263 665c255d 2023-08-04 jrmu (cons-stream 1.0
264 665c255d 2023-08-04 jrmu (stream-map (lambda (guess)
265 665c255d 2023-08-04 jrmu (sqrt-improve guess x))
266 665c255d 2023-08-04 jrmu (sqrt-stream x))))
268 665c255d 2023-08-04 jrmu ;; Alyssa P. Hacker replies that this version of the procedure is considerably less efficient because it performs redundant computation. Explain Alyssa's answer. Would the two versions still differ in efficiency if our implementation of delay used only (lambda () <exp>) without using the optimization provided by memo-proc (section 3.5.1)?
270 665c255d 2023-08-04 jrmu ;; by defining guesses, the procedure is able to take advantage of the fact that the previous terms in the stream have been calculated before. When mapping guesses, the delayed objects in the stream which have already been evaluated can simply return their memoized values. Without guesses, each new iteration would require the computation (from scratch) of each previous iteration.
272 665c255d 2023-08-04 jrmu ;; without the optimization, the two implementations would be equally inefficient