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))
88 665c255d 2023-08-04 jrmu (define (fibgen a b)
89 665c255d 2023-08-04 jrmu (cons-stream a (fibgen b (+ a b))))
90 665c255d 2023-08-04 jrmu (define fibs (fibgen 0 1))
92 665c255d 2023-08-04 jrmu (define (sieve s)
93 665c255d 2023-08-04 jrmu (cons-stream
94 665c255d 2023-08-04 jrmu (stream-car s)
95 665c255d 2023-08-04 jrmu (sieve (stream-filter
97 665c255d 2023-08-04 jrmu (not (divisible? x (stream-car s))))
98 665c255d 2023-08-04 jrmu (stream-cdr s)))))
100 665c255d 2023-08-04 jrmu (define ones (cons-stream 1 ones))
101 665c255d 2023-08-04 jrmu (define (add-streams s1 s2)
102 665c255d 2023-08-04 jrmu (stream-map + s1 s2))
103 665c255d 2023-08-04 jrmu (define integers (cons-stream 1 (add-streams ones integers)))
105 665c255d 2023-08-04 jrmu (define fibs
106 665c255d 2023-08-04 jrmu (cons-stream 0
107 665c255d 2023-08-04 jrmu (cons-stream 1
108 665c255d 2023-08-04 jrmu (add-streams (stream-cdr fibs)
111 665c255d 2023-08-04 jrmu (define (scale-stream stream factor)
112 665c255d 2023-08-04 jrmu (stream-map (lambda (x)
113 665c255d 2023-08-04 jrmu (* x factor))
116 665c255d 2023-08-04 jrmu (define primes
117 665c255d 2023-08-04 jrmu (cons-stream
119 665c255d 2023-08-04 jrmu (stream-filter prime? (integers-starting-from 3))))
120 665c255d 2023-08-04 jrmu (define (prime? n)
121 665c255d 2023-08-04 jrmu (define (iter ps)
122 665c255d 2023-08-04 jrmu (cond ((> (square (stream-car ps)) n) true)
123 665c255d 2023-08-04 jrmu ((divisible? n (stream-car ps)) false)
124 665c255d 2023-08-04 jrmu (else (iter (stream-cdr ps)))))
125 665c255d 2023-08-04 jrmu (iter primes))
127 665c255d 2023-08-04 jrmu (define (mul-streams s1 s2)
128 665c255d 2023-08-04 jrmu (stream-map * s1 s2))
130 665c255d 2023-08-04 jrmu (define (partial-sums s)
131 665c255d 2023-08-04 jrmu (define sums
132 665c255d 2023-08-04 jrmu (cons-stream (stream-car s)
133 665c255d 2023-08-04 jrmu (add-streams sums
134 665c255d 2023-08-04 jrmu (stream-cdr s))))
137 665c255d 2023-08-04 jrmu (define (merge s1 s2)
138 665c255d 2023-08-04 jrmu (cond ((stream-null? s1) s2)
139 665c255d 2023-08-04 jrmu ((stream-null? s2) s1)
141 665c255d 2023-08-04 jrmu (let ((s1car (stream-car s1))
142 665c255d 2023-08-04 jrmu (s2car (stream-car s2)))
143 665c255d 2023-08-04 jrmu (cond ((< s1car s2car)
144 665c255d 2023-08-04 jrmu (cons-stream
146 665c255d 2023-08-04 jrmu (merge (stream-cdr s1) s2)))
147 665c255d 2023-08-04 jrmu ((> s1car s2car)
148 665c255d 2023-08-04 jrmu (cons-stream
150 665c255d 2023-08-04 jrmu (merge s1 (stream-cdr s2))))
152 665c255d 2023-08-04 jrmu (cons-stream
154 665c255d 2023-08-04 jrmu (merge (stream-cdr s1) (stream-cdr s2)))))))))
156 665c255d 2023-08-04 jrmu (define (test-stream-list stream list)
157 665c255d 2023-08-04 jrmu (if (null? list)
159 665c255d 2023-08-04 jrmu (begin (display "A: ")
160 665c255d 2023-08-04 jrmu (display (stream-car stream))
161 665c255d 2023-08-04 jrmu (display " -- ")
162 665c255d 2023-08-04 jrmu (display "E: ")
163 665c255d 2023-08-04 jrmu (display (car list))
165 665c255d 2023-08-04 jrmu (test-stream-list (stream-cdr stream) (cdr list)))))
167 665c255d 2023-08-04 jrmu (define (integrate-series a)
168 665c255d 2023-08-04 jrmu (stream-map / a integers))
170 665c255d 2023-08-04 jrmu (define exp-series
171 665c255d 2023-08-04 jrmu (cons-stream 1 (integrate-series exp-series)))
173 665c255d 2023-08-04 jrmu (define cosine-series
174 665c255d 2023-08-04 jrmu (cons-stream
176 665c255d 2023-08-04 jrmu (integrate-series (stream-map - sine-series))))
177 665c255d 2023-08-04 jrmu (define sine-series
178 665c255d 2023-08-04 jrmu (cons-stream
180 665c255d 2023-08-04 jrmu (integrate-series cosine-series)))
182 665c255d 2023-08-04 jrmu (define (mul-series s1 s2)
183 665c255d 2023-08-04 jrmu (cons-stream
184 665c255d 2023-08-04 jrmu (* (stream-car s1) (stream-car s2))
185 665c255d 2023-08-04 jrmu (add-streams
186 665c255d 2023-08-04 jrmu (scale-stream (stream-cdr s2) (stream-car s1))
187 665c255d 2023-08-04 jrmu (mul-series (stream-cdr s1) s2))))
189 665c255d 2023-08-04 jrmu (define (invert-unit-series s)
191 665c255d 2023-08-04 jrmu (cons-stream
193 665c255d 2023-08-04 jrmu (mul-series (stream-map - (stream-cdr s))
197 665c255d 2023-08-04 jrmu (define (div-series num den)
198 665c255d 2023-08-04 jrmu (let ((den-car (stream-car den)))
199 665c255d 2023-08-04 jrmu (if (zero? den-car)
200 665c255d 2023-08-04 jrmu (error "Denominator has zero constant term -- DIV-SERIES")
201 665c255d 2023-08-04 jrmu (scale-stream
202 665c255d 2023-08-04 jrmu (mul-series
204 665c255d 2023-08-04 jrmu (invert-unit-series (scale-stream den (/ 1 den-car))))
205 665c255d 2023-08-04 jrmu (/ 1 den-car)))))
208 665c255d 2023-08-04 jrmu (define (sqrt-improve guess x)
209 665c255d 2023-08-04 jrmu (define (average x y)
210 665c255d 2023-08-04 jrmu (/ (+ x y) 2))
211 665c255d 2023-08-04 jrmu (average guess (/ x guess)))
213 665c255d 2023-08-04 jrmu (define (sqrt-stream x)
214 665c255d 2023-08-04 jrmu (define guesses
215 665c255d 2023-08-04 jrmu (cons-stream
217 665c255d 2023-08-04 jrmu (stream-map (lambda (guess)
218 665c255d 2023-08-04 jrmu (sqrt-improve guess x))
222 665c255d 2023-08-04 jrmu (define (pi-summands n)
223 665c255d 2023-08-04 jrmu (cons-stream (/ 1 n)
224 665c255d 2023-08-04 jrmu (stream-map - (pi-summands (+ n 2)))))
225 665c255d 2023-08-04 jrmu (define pi-stream
226 665c255d 2023-08-04 jrmu (scale-stream (partial-sums (pi-summands 1)) 4))
228 665c255d 2023-08-04 jrmu (define (euler-transform s)
229 665c255d 2023-08-04 jrmu (let ((s0 (stream-ref s 0))
230 665c255d 2023-08-04 jrmu (s1 (stream-ref s 1))
231 665c255d 2023-08-04 jrmu (s2 (stream-ref s 2)))
232 665c255d 2023-08-04 jrmu (cons-stream
233 665c255d 2023-08-04 jrmu (- s2 (/ (square (- s2 s1))
234 665c255d 2023-08-04 jrmu (+ s0 (* -2 s1) s2)))
235 665c255d 2023-08-04 jrmu (euler-transform (stream-cdr s)))))
237 665c255d 2023-08-04 jrmu (define (make-tableau transform s)
238 665c255d 2023-08-04 jrmu (cons-stream s
239 665c255d 2023-08-04 jrmu (make-tableau transform
240 665c255d 2023-08-04 jrmu (transform s))))
242 665c255d 2023-08-04 jrmu (define (stream-limit s tol)
243 665c255d 2023-08-04 jrmu (let* ((scar (stream-car s))
244 665c255d 2023-08-04 jrmu (scdr (stream-cdr s))
245 665c255d 2023-08-04 jrmu (scadr (stream-car scdr)))
246 665c255d 2023-08-04 jrmu (if (< (abs (- scar scadr)) tol)
248 665c255d 2023-08-04 jrmu (stream-limit scdr tol))))
250 665c255d 2023-08-04 jrmu (define (sqrt x tolerance)
251 665c255d 2023-08-04 jrmu (stream-limit (sqrt-stream x) tolerance))
253 665c255d 2023-08-04 jrmu (define (pairs s t)
254 665c255d 2023-08-04 jrmu (cons-stream
255 665c255d 2023-08-04 jrmu (list (stream-car s) (stream-car t))
256 665c255d 2023-08-04 jrmu (interleave
257 665c255d 2023-08-04 jrmu (stream-map
258 665c255d 2023-08-04 jrmu (lambda (x)
259 665c255d 2023-08-04 jrmu (list (stream-car s) x))
260 665c255d 2023-08-04 jrmu (stream-cdr t))
261 665c255d 2023-08-04 jrmu (pairs (stream-cdr s) (stream-cdr t)))))
262 665c255d 2023-08-04 jrmu (define (interleave s1 s2)
263 665c255d 2023-08-04 jrmu (if (stream-null? s1)
265 665c255d 2023-08-04 jrmu (cons-stream (stream-car s1)
266 665c255d 2023-08-04 jrmu (interleave s2 (stream-cdr s1)))))
268 665c255d 2023-08-04 jrmu (define (display-streams n . streams)
269 665c255d 2023-08-04 jrmu (if (> n 0)
270 665c255d 2023-08-04 jrmu (begin (newline)
272 665c255d 2023-08-04 jrmu (lambda (s)
273 665c255d 2023-08-04 jrmu (display (stream-car s))
274 665c255d 2023-08-04 jrmu (display " -- "))
276 665c255d 2023-08-04 jrmu (apply display-streams
277 665c255d 2023-08-04 jrmu (cons (- n 1) (map stream-cdr streams))))))
279 665c255d 2023-08-04 jrmu (define (all-pairs s t)
280 665c255d 2023-08-04 jrmu (cons-stream
281 665c255d 2023-08-04 jrmu (list (stream-car s) (stream-car t))
282 665c255d 2023-08-04 jrmu (interleave
283 665c255d 2023-08-04 jrmu (stream-map
284 665c255d 2023-08-04 jrmu (lambda (x)
285 665c255d 2023-08-04 jrmu (list x (stream-car t)))
286 665c255d 2023-08-04 jrmu (stream-cdr s))
287 665c255d 2023-08-04 jrmu (interleave
288 665c255d 2023-08-04 jrmu (stream-map
289 665c255d 2023-08-04 jrmu (lambda (x)
290 665c255d 2023-08-04 jrmu (list (stream-car s) x))
291 665c255d 2023-08-04 jrmu (stream-cdr t))
292 665c255d 2023-08-04 jrmu (all-pairs (stream-cdr s) (stream-cdr t))))))
294 665c255d 2023-08-04 jrmu (define (triples s t u)
295 665c255d 2023-08-04 jrmu (cons-stream
296 665c255d 2023-08-04 jrmu (list (stream-car s) (stream-car t) (stream-car u))
297 665c255d 2023-08-04 jrmu (interleave
298 665c255d 2023-08-04 jrmu (stream-cdr (stream-map (lambda (pair)
299 665c255d 2023-08-04 jrmu (cons (stream-car s) pair))
300 665c255d 2023-08-04 jrmu (pairs t u)))
301 665c255d 2023-08-04 jrmu (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
303 665c255d 2023-08-04 jrmu (define pythag-triples
304 665c255d 2023-08-04 jrmu (stream-filter
305 665c255d 2023-08-04 jrmu (lambda (triple)
306 665c255d 2023-08-04 jrmu (let ((i (car triple))
307 665c255d 2023-08-04 jrmu (j (cadr triple))
308 665c255d 2023-08-04 jrmu (k (caddr triple)))
309 665c255d 2023-08-04 jrmu (= (square k) (+ (square i) (square j)))))
310 665c255d 2023-08-04 jrmu (triples integers integers integers)))
312 665c255d 2023-08-04 jrmu (define (merge-weighted s1 s2 weight)
313 665c255d 2023-08-04 jrmu (cond ((stream-null? s1) s2)
314 665c255d 2023-08-04 jrmu ((stream-null? s2) s1)
316 665c255d 2023-08-04 jrmu (let ((s1car (stream-car s1))
317 665c255d 2023-08-04 jrmu (s2car (stream-car s2)))
318 665c255d 2023-08-04 jrmu (if (<= (weight s1car) (weight s2car))
319 665c255d 2023-08-04 jrmu (cons-stream
321 665c255d 2023-08-04 jrmu (merge-weighted (stream-cdr s1) s2 weight))
322 665c255d 2023-08-04 jrmu (cons-stream
324 665c255d 2023-08-04 jrmu (merge-weighted s1 (stream-cdr s2) weight)))))))
326 665c255d 2023-08-04 jrmu (define (weighted-pairs s t weight)
327 665c255d 2023-08-04 jrmu (cons-stream
328 665c255d 2023-08-04 jrmu (list (stream-car s) (stream-car t))
329 665c255d 2023-08-04 jrmu (merge-weighted
330 665c255d 2023-08-04 jrmu (stream-map
331 665c255d 2023-08-04 jrmu (lambda (x)
332 665c255d 2023-08-04 jrmu (list (stream-car s) x))
333 665c255d 2023-08-04 jrmu (stream-cdr t))
334 665c255d 2023-08-04 jrmu (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
337 665c255d 2023-08-04 jrmu (define (integral integrand initial-value dt)
338 665c255d 2023-08-04 jrmu (define int
339 665c255d 2023-08-04 jrmu (cons-stream initial-value
340 665c255d 2023-08-04 jrmu (add-streams (scale-stream integrand dt)
344 665c255d 2023-08-04 jrmu ;; Exercise 3.73
346 665c255d 2023-08-04 jrmu ;; 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 665c255d 2023-08-04 jrmu ;; 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.
350 665c255d 2023-08-04 jrmu (define (RC R C dt)
351 665c255d 2023-08-04 jrmu (lambda (i v0)
352 665c255d 2023-08-04 jrmu (add-streams (integral (scale-stream i (/ 1 C)) v0 dt)
353 665c255d 2023-08-04 jrmu (scale-stream i R))))
354 665c255d 2023-08-04 jrmu (define RC1 (RC 5 1 0.5))
355 665c255d 2023-08-04 jrmu ;; (test-stream-list (RC1 integers 0.2) '(5.2 10.7 16.7 32.2 30.2))
356 665c255d 2023-08-04 jrmu ;; not even sure if this test makes sense, I just copied it from Barry Allison's site
