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))))
252 (list (stream-car s) (stream-car t))
256 (list (stream-car s) x))
258 (pairs (stream-cdr s) (stream-cdr t)))))
259 (define (interleave s1 s2)
260 (if (stream-null? s1)
262 (cons-stream (stream-car s1)
263 (interleave s2 (stream-cdr s1)))))
265 (define (display-streams n . streams)
270 (display (stream-car s))
273 (apply display-streams
274 (cons (- n 1) (map stream-cdr streams))))))
276 (define (all-pairs s t)
278 (list (stream-car s) (stream-car t))
282 (list x (stream-car t)))
287 (list (stream-car s) x))
289 (all-pairs (stream-cdr s) (stream-cdr t))))))
291 (define (triples s t u)
293 (list (stream-car s) (stream-car t) (stream-car u))
295 (stream-cdr (stream-map (lambda (pair)
296 (cons (stream-car s) pair))
298 (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
300 (define pythag-triples
303 (let ((i (car triple))
306 (= (square k) (+ (square i) (square j)))))
307 (triples integers integers integers)))
309 (define (merge-weighted s1 s2 weight)
310 (cond ((stream-null? s1) s2)
311 ((stream-null? s2) s1)
313 (let ((s1car (stream-car s1))
314 (s2car (stream-car s2)))
315 (if (<= (weight s1car) (weight s2car))
318 (merge-weighted (stream-cdr s1) s2 weight))
321 (merge-weighted s1 (stream-cdr s2) weight)))))))
323 (define (weighted-pairs s t weight)
325 (list (stream-car s) (stream-car t))
329 (list (stream-car s) x))
331 (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
334 (define (integral integrand initial-value dt)
336 (cons-stream initial-value
337 (add-streams (scale-stream integrand dt)
341 (define (list->stream list)
344 (cons-stream (car list)
345 (list->stream (cdr list)))))
347 (define (solve f y0 dt)
348 (define y (integral (mydelay dy) y0 dt))
349 (define dy (stream-map f y))
352 (define (integral delayed-integrand initial-value dt)
354 (cons-stream initial-value
355 (let ((integrand (myforce delayed-integrand)))
356 (add-streams (scale-stream integrand dt)
361 ;; (let ((x random-init))
363 ;; (set! x (rand-update x))
366 ;; (define (rand-update x)
367 ;; (let ((a (expt 2 32))
370 ;; (modulo (+ (* a x) c) m)))
371 ;; (define random-init 137)
374 ;; (define random-numbers
375 ;; (cons-stream random-init
376 ;; (stream-map rand-update random-numbers)))
378 ;; (define (map-successive-pairs f s)
380 ;; (f (stream-car s) (stream-car (stream-cdr s)))
381 ;; (map-successive-pairs f (stream-cdr (stream-cdr s)))))
383 ;; (define cesaro-stream
384 ;; (map-successive-pairs (lambda (r1 r2)
385 ;; (= (gcd r1 r2) 1))
388 ;; (define (monte-carlo experiment-stream pass fail)
389 ;; (define (next pass fail)
391 ;; (/ pass (+ pass fail))
393 ;; (stream-cdr experiment-stream) pass fail)))
394 ;; (if (stream-car experiment-stream)
395 ;; (next (+ pass 1) fail)
396 ;; (next pass (+ fail 1))))
398 ;; (define pi (stream-map (lambda (p) (sqrt (/ 6.0 p)))
399 ;; (monte-carlo cesaro-stream 0 0)))
400 ;; (display-streams 100 pi)
402 ;; Exercise 3.81. Exercise 3.6 discussed generalizing the random-number generator to allow one to reset the random-number sequence so as to produce repeatable sequences of ``random'' numbers. Produce a stream formulation of this same generator that operates on an input stream of requests to generate a new random number or to reset the sequence to a specified value and that produces the desired stream of random numbers. Don't use assignment in your solution.
404 ;;(define (rand-update x)
406 ;; (random (expt 2 31)))
407 (define (rand-update x)
408 (let ((a (expt 2 32))
411 (modulo (+ (* a x) c) m)))
412 (define initial-seed 12392)
413 (rand-update initial-seed)
416 (define (random-number-generator commands)
417 (define (choose seed command)
418 (if (and (pair? command) (eq? (car command) 'reset))
419 (rand-update (cadr command))
421 (if (stream-null? commands)
424 (choose (rand-update initial-seed) (stream-car commands))
426 (random-number-generator commands)
429 (define random-commands '(gen gen gen gen gen (reset 137) gen gen gen (reset 293123) gen gen gen gen (reset 293123) gen gen gen gen (reset 137) gen gen gen gen gen gen))
430 (define random-numbers (random-number-generator (list->stream random-commands)))
432 (test-stream-list random-numbers random-commands)
434 ;; this actually has a delay after reset, so it's not ideal
