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))))
250 (define (sqrt x tolerance)
251 (stream-limit (sqrt-stream x) tolerance))
255 (list (stream-car s) (stream-car t))
259 (list (stream-car s) x))
261 (pairs (stream-cdr s) (stream-cdr t)))))
262 (define (interleave s1 s2)
263 (if (stream-null? s1)
265 (cons-stream (stream-car s1)
266 (interleave s2 (stream-cdr s1)))))
268 (define (display-streams n . streams)
273 (display (stream-car s))
276 (apply display-streams
277 (cons (- n 1) (map stream-cdr streams))))))
279 (define (all-pairs s t)
281 (list (stream-car s) (stream-car t))
285 (list x (stream-car t)))
290 (list (stream-car s) x))
292 (all-pairs (stream-cdr s) (stream-cdr t))))))
294 (define (triples s t u)
296 (list (stream-car s) (stream-car t) (stream-car u))
298 (stream-cdr (stream-map (lambda (pair)
299 (cons (stream-car s) pair))
301 (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
303 (define pythag-triples
306 (let ((i (car triple))
309 (= (square k) (+ (square i) (square j)))))
310 (triples integers integers integers)))
312 (define (merge-weighted s1 s2 weight)
313 (cond ((stream-null? s1) s2)
314 ((stream-null? s2) s1)
316 (let ((s1car (stream-car s1))
317 (s2car (stream-car s2)))
318 (if (<= (weight s1car) (weight s2car))
321 (merge-weighted (stream-cdr s1) s2 weight))
324 (merge-weighted s1 (stream-cdr s2) weight)))))))
326 (define (weighted-pairs s t weight)
328 (list (stream-car s) (stream-car t))
332 (list (stream-car s) x))
334 (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
337 (define (integral integrand initial-value dt)
339 (cons-stream initial-value
340 (add-streams (scale-stream integrand dt)
344 ;; Exercise 3.74. Alyssa P. Hacker is designing a system to process signals coming from physical sensors. One important feature she wishes to produce is a signal that describes the zero crossings of the input signal. That is, the resulting signal should be + 1 whenever the input signal changes from negative to positive, - 1 whenever the input signal changes from positive to negative, and 0 otherwise. (Assume that the sign of a 0 input is positive.) For example, a typical input signal with its associated zero-crossing signal would be
346 ;;1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4
347 ;;0 0 0 0 0 -1 0 0 0 0 1 0
349 ;; In Alyssa's system, the signal from the sensor is represented as a stream sense-data and the stream zero-crossings is the corresponding stream of zero crossings. Alyssa first writes a procedure sign-change-detector that takes two values as arguments and compares the signs of the values to produce an appropriate 0, 1, or - 1. She then constructs her zero-crossing stream as follows:
351 (define (sign-change-detector current-value last-value)
352 (cond ((and (< current-value 0) (>= last-value 0)) -1)
353 ((and (>= current-value 0) (< last-value 0)) 1)
356 (define (make-zero-crossings input-stream last-value)
358 (sign-change-detector (stream-car input-stream) last-value)
359 (make-zero-crossings (stream-cdr input-stream)
360 (stream-car input-stream))))
362 (define (list->stream list)
365 (cons-stream (car list)
366 (list->stream (cdr list)))))
368 ;; (define zero-crossings (make-zero-crossings sense-data 0))
370 ;; Alyssa's boss, Eva Lu Ator, walks by and suggests that this program is approximately equivalent to the following one, which uses the generalized version of stream-map from exercise 3.50:
372 (define zero-crossings
373 (stream-map sign-change-detector
375 (cons-stream 0 sense-data)))
377 (define sense-data (list->stream '(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4)))
379 ;; (test-stream-list zero-crossings '(0 0 0 0 0 -1 0 0 0 0 1 0))
381 ;; Exercise 3.75. Unfortunately, Alyssa's zero-crossing detector in exercise 3.74 proves to be insufficient, because the noisy signal from the sensor leads to spurious zero crossings. Lem E. Tweakit, a hardware specialist, suggests that Alyssa smooth the signal to filter out the noise before extracting the zero crossings. Alyssa takes his advice and decides to extract the zero crossings from the signal constructed by averaging each value of the sense data with the previous value. She explains the problem to her assistant, Louis Reasoner, who attempts to implement the idea, altering Alyssa's program as follows:
383 ;; (define (make-zero-crossings input-stream last-value)
384 ;; (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
385 ;; (cons-stream (sign-change-detector avpt last-value)
386 ;; (make-zero-crossings (stream-cdr input-stream)
389 ;; The problem is that (make-zero-crossings (stream-cdr input-stream) avpt) passes avpt as the last value but this is not really the last value. This has already been averaged and so is not part of the original data.
391 (define (make-zero-crossings input-stream last-value last-avg)
392 (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
393 (cons-stream (sign-change-detector avpt last-avg)
394 (make-zero-crossings (stream-cdr input-stream)
395 (stream-car input-stream)
398 ;; This does not correctly implement Alyssa's plan. Find the bug that Louis has installed and fix it without changing the structure of the program. (Hint: You will need to increase the number of arguments to make-zero-crossings.)
400 Exercise 3.76. Eva Lu Ator has a criticism of Louis's approach in exercise 3.75. The program he wrote is not modular, because it intermixes the operation of smoothing with the zero-crossing extraction. For example, the extractor should not have to be changed if Alyssa finds a better way to condition her input signal. Help Louis by writing a procedure smooth that takes a stream as input and produces a stream in which each element is the average of two successive input stream elements. Then use smooth as a component to implement the zero-crossing detector in a more modular style.
