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)
346 ;; We can model electrical circuits using streams to represent the values of currents or voltages at a sequence of times. For instance, suppose we have an RC circuit consisting of a resistor of resistance R and a capacitor of capacitance C in series. The voltage response v of the circuit to an injected current i is determined by the formula in figure 3.33, whose structure is shown by the accompanying signal-flow diagram.
348 ;; Write a procedure RC that models this circuit. RC should take as inputs the values of R, C, and dt and should return a procedure that takes as inputs a stream representing the current i and an initial value for the capacitor voltage v0 and produces as output the stream of voltages v. For example, you should be able to use RC to model an RC circuit with R = 5 ohms, C = 1 farad, and a 0.5-second time step by evaluating (define RC1 (RC 5 1 0.5)). This defines RC1 as a procedure that takes a stream representing the time sequence of currents and an initial capacitor voltage and produces the output stream of voltages.
352 (add-streams (integral (scale-stream i (/ 1 C)) v0 dt)
353 (scale-stream i R))))
354 (define RC1 (RC 5 1 0.5))
355 ;; (test-stream-list (RC1 integers 0.2) '(5.2 10.7 16.7 32.2 30.2))
356 ;; not even sure if this test makes sense, I just copied it from Barry Allison's site
