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))
229 ;; (test-stream-list (stream-map exact->inexact (sqrt-stream 2))
230 ;; '(1 1.5 1.4166 1.4142156 1.41421356))
232 (define (pi-summands n)
234 (stream-map - (pi-summands (+ n 2)))))
236 (scale-stream (partial-sums (pi-summands 1)) 4))
237 ;; (test-stream-list (stream-map exact->inexact pi-stream)
238 ;; '(4 2.6667 3.4667 2.8952 3.3397))
240 (define (euler-transform s)
241 (let ((s0 (stream-ref s 0))
242 (s1 (stream-ref s 1))
243 (s2 (stream-ref s 2)))
245 (- s2 (/ (square (- s2 s1))
246 (+ s0 (* -2 s1) s2)))
247 (euler-transform (stream-cdr s)))))
249 ;; (test-stream-list (stream-map exact->inexact (euler-transform pi-stream))
250 ;; '(3.1667 3.1333 3.1452 3.1397 3.1427))
252 (define (make-tableau transform s)
254 (make-tableau transform
257 ;; (test-stream-list (stream-map exact->inexact (stream-map stream-car (make-tableau euler-transform pi-stream)))
258 ;; '(4 3.1667 3.1421 3.1459935 3.1415927140 3.145926539752927))
260 ;; Exercise 3.64. Write a procedure stream-limit that takes as arguments a stream and a number (the tolerance). It should examine the stream until it finds two successive elements that differ in absolute value by less than the tolerance, and return the second of the two elements. Using this, we could compute square roots up to a given tolerance by
262 (define (stream-limit s tol)
263 (let* ((scar (stream-car s))
264 (scdr (stream-cdr s))
265 (scadr (stream-car scdr)))
266 (if (< (abs (- scar scadr)) tol)
268 (stream-limit scdr tol))))
270 (define (sqrt x tolerance)
271 (stream-limit (sqrt-stream x) tolerance))
273 (test-case (sqrt 23.0 0.00000001) 4.79583152)
