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))
230 665c255d 2023-08-04 jrmu (define (pi-summands n)
231 665c255d 2023-08-04 jrmu (cons-stream (/ 1 n)
232 665c255d 2023-08-04 jrmu (stream-map - (pi-summands (+ n 2)))))
233 665c255d 2023-08-04 jrmu (define pi-stream
234 665c255d 2023-08-04 jrmu (scale-stream (partial-sums (pi-summands 1)) 4))
236 665c255d 2023-08-04 jrmu (define (euler-transform s)
237 665c255d 2023-08-04 jrmu (let ((s0 (stream-ref s 0))
238 665c255d 2023-08-04 jrmu (s1 (stream-ref s 1))
239 665c255d 2023-08-04 jrmu (s2 (stream-ref s 2)))
240 665c255d 2023-08-04 jrmu (cons-stream
241 665c255d 2023-08-04 jrmu (- s2 (/ (square (- s2 s1))
242 665c255d 2023-08-04 jrmu (+ s0 (* -2 s1) s2)))
243 665c255d 2023-08-04 jrmu (euler-transform (stream-cdr s)))))
245 665c255d 2023-08-04 jrmu (define (make-tableau transform s)
246 665c255d 2023-08-04 jrmu (cons-stream s
247 665c255d 2023-08-04 jrmu (make-tableau transform
248 665c255d 2023-08-04 jrmu (transform s))))
250 665c255d 2023-08-04 jrmu (define (stream-limit s tol)
251 665c255d 2023-08-04 jrmu (let* ((scar (stream-car s))
252 665c255d 2023-08-04 jrmu (scdr (stream-cdr s))
253 665c255d 2023-08-04 jrmu (scadr (stream-car scdr)))
254 665c255d 2023-08-04 jrmu (if (< (abs (- scar scadr)) tol)
256 665c255d 2023-08-04 jrmu (stream-limit scdr tol))))
258 665c255d 2023-08-04 jrmu (define (sqrt x tolerance)
259 665c255d 2023-08-04 jrmu (stream-limit (sqrt-stream x) tolerance))
261 665c255d 2023-08-04 jrmu (define (pairs s t)
262 665c255d 2023-08-04 jrmu (cons-stream
263 665c255d 2023-08-04 jrmu (list (stream-car s) (stream-car t))
264 665c255d 2023-08-04 jrmu (interleave
265 665c255d 2023-08-04 jrmu (stream-map
266 665c255d 2023-08-04 jrmu (lambda (x)
267 665c255d 2023-08-04 jrmu (list (stream-car s) x))
268 665c255d 2023-08-04 jrmu (stream-cdr t))
269 665c255d 2023-08-04 jrmu (pairs (stream-cdr s) (stream-cdr t)))))
270 665c255d 2023-08-04 jrmu (define (interleave s1 s2)
271 665c255d 2023-08-04 jrmu (if (stream-null? s1)
273 665c255d 2023-08-04 jrmu (cons-stream (stream-car s1)
274 665c255d 2023-08-04 jrmu (interleave s2 (stream-cdr s1)))))
276 665c255d 2023-08-04 jrmu (define (display-streams n . streams)
277 665c255d 2023-08-04 jrmu (if (> n 0)
278 665c255d 2023-08-04 jrmu (begin (newline)
280 665c255d 2023-08-04 jrmu (lambda (s)
281 665c255d 2023-08-04 jrmu (display (stream-car s))
282 665c255d 2023-08-04 jrmu (display " -- "))
284 665c255d 2023-08-04 jrmu (apply display-streams
285 665c255d 2023-08-04 jrmu (cons (- n 1) (map stream-cdr streams))))))
287 665c255d 2023-08-04 jrmu ;; 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 665c255d 2023-08-04 jrmu ;; (define the-pairs (pairs integers integers))
290 665c255d 2023-08-04 jrmu ;; (test-stream-list the-pairs
291 665c255d 2023-08-04 jrmu ;; '((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 665c255d 2023-08-04 jrmu ;; 2(j-1) for the pair (1, j) for j > 1
294 665c255d 2023-08-04 jrmu ;; 2(2(j-2))+1 for the pair (2, j) for j > 1
295 665c255d 2023-08-04 jrmu ;; 2(2(2(j-3)))+3 for the pair (3, j) for j > 1
296 665c255d 2023-08-04 jrmu ;; 2(2(2(2(j-4))))+7 for the pair (4, j) for j > 1
297 665c255d 2023-08-04 jrmu ;; 2(2(2(2(2(j-5)))))+15
299 665c255d 2023-08-04 jrmu ;; So, in general, (2^i)(j-i)+[summation of 2^(x-2)] from x = 2 to x = i
301 665c255d 2023-08-04 jrmu ;; (1, 100) will appear as term 2(100-1) = 198
302 665c255d 2023-08-04 jrmu ;; (test-case (stream-ref the-pairs 197) '(1 100))
303 665c255d 2023-08-04 jrmu ;; (display-streams 100 the-pairs integers)
305 665c255d 2023-08-04 jrmu (define double-summation (partial-sums double))
307 665c255d 2023-08-04 jrmu (stream-ref double-summation 97)
309 665c255d 2023-08-04 jrmu (display "New")
311 665c255d 2023-08-04 jrmu (stream-ref double-summation 98)
