1 665c255d 2023-08-04 jrmu (define (memo-proc proc)
  2 665c255d 2023-08-04 jrmu   (let ((already-run? false) (result false))
  3 665c255d 2023-08-04 jrmu     (lambda ()
  4 665c255d 2023-08-04 jrmu       (if already-run?
  5 665c255d 2023-08-04 jrmu 	  result
  6 665c255d 2023-08-04 jrmu 	  (begin (set! already-run? true)
  7 665c255d 2023-08-04 jrmu 		 (set! result (proc))
  8 665c255d 2023-08-04 jrmu 		 result)))))
  9 665c255d 2023-08-04 jrmu 
 10 665c255d 2023-08-04 jrmu (define-syntax mydelay
 11 665c255d 2023-08-04 jrmu   (rsc-macro-transformer
 12 665c255d 2023-08-04 jrmu    (let ((xfmr
 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))))))
 17 665c255d 2023-08-04 jrmu 
 18 665c255d 2023-08-04 jrmu (define (myforce delayed-object)
 19 665c255d 2023-08-04 jrmu   (delayed-object))
 20 665c255d 2023-08-04 jrmu 
 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))))))
 26 665c255d 2023-08-04 jrmu 
 27 665c255d 2023-08-04 jrmu (define (stream-car s)
 28 665c255d 2023-08-04 jrmu   (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 '())
 33 665c255d 2023-08-04 jrmu 
 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))))
 36 665c255d 2023-08-04 jrmu 
 37 665c255d 2023-08-04 jrmu (define (stream-ref s n)
 38 665c255d 2023-08-04 jrmu   (if (= n 0)
 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)
 49 665c255d 2023-08-04 jrmu       'done
 50 665c255d 2023-08-04 jrmu       (begin (proc (stream-car s))
 51 665c255d 2023-08-04 jrmu 	     (stream-for-each proc (stream-cdr s)))))
 52 665c255d 2023-08-04 jrmu 
 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 
 57 665c255d 2023-08-04 jrmu        low
 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))))))
 66 665c255d 2023-08-04 jrmu 
 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)
 70 665c255d 2023-08-04 jrmu   (newline)
 71 665c255d 2023-08-04 jrmu   (display x))
 72 665c255d 2023-08-04 jrmu 
 73 665c255d 2023-08-04 jrmu (define (test-case actual expected)
 74 665c255d 2023-08-04 jrmu   (newline)
 75 665c255d 2023-08-04 jrmu   (display "Actual:   ")
 76 665c255d 2023-08-04 jrmu   (display actual)
 77 665c255d 2023-08-04 jrmu   (newline)
 78 665c255d 2023-08-04 jrmu   (display "Expected: ")
 79 665c255d 2023-08-04 jrmu   (display expected)
 80 665c255d 2023-08-04 jrmu   (newline))
 81 665c255d 2023-08-04 jrmu 
 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))
 85 665c255d 2023-08-04 jrmu 
 86 665c255d 2023-08-04 jrmu (define (divisible? x y) (= (remainder x y) 0))
 87 665c255d 2023-08-04 jrmu 
 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))
 91 665c255d 2023-08-04 jrmu 
 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
 96 665c255d 2023-08-04 jrmu 	   (lambda (x)
 97 665c255d 2023-08-04 jrmu 	     (not (divisible? x (stream-car s))))
 98 665c255d 2023-08-04 jrmu 	   (stream-cdr s)))))
 99 665c255d 2023-08-04 jrmu 
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)))
104 665c255d 2023-08-04 jrmu 
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)
109 665c255d 2023-08-04 jrmu 					 fibs))))
110 665c255d 2023-08-04 jrmu 
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))
114 665c255d 2023-08-04 jrmu 	      stream))
115 665c255d 2023-08-04 jrmu 
116 665c255d 2023-08-04 jrmu (define primes
117 665c255d 2023-08-04 jrmu   (cons-stream 
118 665c255d 2023-08-04 jrmu    2
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))
126 665c255d 2023-08-04 jrmu 
127 665c255d 2023-08-04 jrmu (define (mul-streams s1 s2)
128 665c255d 2023-08-04 jrmu   (stream-map * s1 s2))
129 665c255d 2023-08-04 jrmu 
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))))
135 665c255d 2023-08-04 jrmu   sums)
136 665c255d 2023-08-04 jrmu 
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)
140 665c255d 2023-08-04 jrmu 	(else
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 
145 665c255d 2023-08-04 jrmu 		   s1car
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
149 665c255d 2023-08-04 jrmu 		   s2car
150 665c255d 2023-08-04 jrmu 		   (merge s1 (stream-cdr s2))))
151 665c255d 2023-08-04 jrmu 		 (else 
152 665c255d 2023-08-04 jrmu 		  (cons-stream 
153 665c255d 2023-08-04 jrmu 		   s1car
154 665c255d 2023-08-04 jrmu 		   (merge (stream-cdr s1) (stream-cdr s2)))))))))
155 665c255d 2023-08-04 jrmu 
156 665c255d 2023-08-04 jrmu (define (test-stream-list stream list)
157 665c255d 2023-08-04 jrmu   (if (null? list)
158 665c255d 2023-08-04 jrmu       'done
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))
164 665c255d 2023-08-04 jrmu 	     (newline)
165 665c255d 2023-08-04 jrmu 	     (test-stream-list (stream-cdr stream) (cdr list)))))
166 665c255d 2023-08-04 jrmu 
167 665c255d 2023-08-04 jrmu (define (integrate-series a)
168 665c255d 2023-08-04 jrmu   (stream-map / a integers))
169 665c255d 2023-08-04 jrmu 
170 665c255d 2023-08-04 jrmu (define exp-series
171 665c255d 2023-08-04 jrmu   (cons-stream 1 (integrate-series exp-series)))
172 665c255d 2023-08-04 jrmu 
173 665c255d 2023-08-04 jrmu (define cosine-series
174 665c255d 2023-08-04 jrmu   (cons-stream 
175 665c255d 2023-08-04 jrmu    1
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 
179 665c255d 2023-08-04 jrmu    0
180 665c255d 2023-08-04 jrmu    (integrate-series cosine-series)))
181 665c255d 2023-08-04 jrmu 
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))))
188 665c255d 2023-08-04 jrmu 
189 665c255d 2023-08-04 jrmu (define (invert-unit-series s)
190 665c255d 2023-08-04 jrmu   (define x
191 665c255d 2023-08-04 jrmu     (cons-stream 
192 665c255d 2023-08-04 jrmu      1
193 665c255d 2023-08-04 jrmu      (mul-series (stream-map - (stream-cdr s))
194 665c255d 2023-08-04 jrmu 		 x)))
195 665c255d 2023-08-04 jrmu   x)
196 665c255d 2023-08-04 jrmu 
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
203 665c255d 2023-08-04 jrmu 	  num
204 665c255d 2023-08-04 jrmu 	  (invert-unit-series (scale-stream den (/ 1 den-car))))
205 665c255d 2023-08-04 jrmu 	 (/ 1 den-car)))))
206 665c255d 2023-08-04 jrmu 
207 665c255d 2023-08-04 jrmu 
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)))
212 665c255d 2023-08-04 jrmu 
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 
216 665c255d 2023-08-04 jrmu      1 
217 665c255d 2023-08-04 jrmu      (stream-map (lambda (guess)
218 665c255d 2023-08-04 jrmu 		   (sqrt-improve guess x))
219 665c255d 2023-08-04 jrmu 		 guesses)))
220 665c255d 2023-08-04 jrmu   guesses)
221 665c255d 2023-08-04 jrmu 
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))
227 665c255d 2023-08-04 jrmu 
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)))))
236 665c255d 2023-08-04 jrmu 
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))))
241 665c255d 2023-08-04 jrmu 
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)
247 665c255d 2023-08-04 jrmu 	scadr
248 665c255d 2023-08-04 jrmu 	(stream-limit scdr tol))))
249 665c255d 2023-08-04 jrmu 
250 665c255d 2023-08-04 jrmu (define (pairs s t)
251 665c255d 2023-08-04 jrmu   (cons-stream 
252 665c255d 2023-08-04 jrmu    (list (stream-car s) (stream-car t))
253 665c255d 2023-08-04 jrmu    (interleave
254 665c255d 2023-08-04 jrmu     (stream-map
255 665c255d 2023-08-04 jrmu      (lambda (x)
256 665c255d 2023-08-04 jrmu        (list (stream-car s) x))
257 665c255d 2023-08-04 jrmu      (stream-cdr t))
258 665c255d 2023-08-04 jrmu     (pairs (stream-cdr s) (stream-cdr t)))))
259 665c255d 2023-08-04 jrmu (define (interleave s1 s2)
260 665c255d 2023-08-04 jrmu   (if (stream-null? s1)
261 665c255d 2023-08-04 jrmu       s2
262 665c255d 2023-08-04 jrmu       (cons-stream (stream-car s1)
263 665c255d 2023-08-04 jrmu 		   (interleave s2 (stream-cdr s1)))))
264 665c255d 2023-08-04 jrmu 
265 665c255d 2023-08-04 jrmu (define (display-streams n . streams)
266 665c255d 2023-08-04 jrmu   (if (> n 0)
267 665c255d 2023-08-04 jrmu       (begin (newline) 
268 665c255d 2023-08-04 jrmu 	     (for-each 
269 665c255d 2023-08-04 jrmu 	      (lambda (s)
270 665c255d 2023-08-04 jrmu 		(display (stream-car s))
271 665c255d 2023-08-04 jrmu 		(display " -- "))
272 665c255d 2023-08-04 jrmu 	      streams)
273 665c255d 2023-08-04 jrmu 	     (apply display-streams
274 665c255d 2023-08-04 jrmu 		    (cons (- n 1) (map stream-cdr streams))))))
275 665c255d 2023-08-04 jrmu 
276 665c255d 2023-08-04 jrmu (define (all-pairs s t)
277 665c255d 2023-08-04 jrmu   (cons-stream
278 665c255d 2023-08-04 jrmu    (list (stream-car s) (stream-car t))
279 665c255d 2023-08-04 jrmu    (interleave
280 665c255d 2023-08-04 jrmu      (stream-map
281 665c255d 2023-08-04 jrmu       (lambda (x)
282 665c255d 2023-08-04 jrmu 	(list x (stream-car t)))
283 665c255d 2023-08-04 jrmu       (stream-cdr s))
284 665c255d 2023-08-04 jrmu      (interleave
285 665c255d 2023-08-04 jrmu       (stream-map
286 665c255d 2023-08-04 jrmu        (lambda (x)
287 665c255d 2023-08-04 jrmu 	 (list (stream-car s) x))
288 665c255d 2023-08-04 jrmu        (stream-cdr t))
289 665c255d 2023-08-04 jrmu       (all-pairs (stream-cdr s) (stream-cdr t))))))
290 665c255d 2023-08-04 jrmu 
291 665c255d 2023-08-04 jrmu (define (triples s t u)
292 665c255d 2023-08-04 jrmu   (cons-stream 
293 665c255d 2023-08-04 jrmu    (list (stream-car s) (stream-car t) (stream-car u))
294 665c255d 2023-08-04 jrmu    (interleave 
295 665c255d 2023-08-04 jrmu     (stream-cdr (stream-map (lambda (pair)
296 665c255d 2023-08-04 jrmu 			      (cons (stream-car s) pair))
297 665c255d 2023-08-04 jrmu 			    (pairs t u)))
298 665c255d 2023-08-04 jrmu     (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))
299 665c255d 2023-08-04 jrmu 
300 665c255d 2023-08-04 jrmu (define pythag-triples 
301 665c255d 2023-08-04 jrmu   (stream-filter
302 665c255d 2023-08-04 jrmu    (lambda (triple)
303 665c255d 2023-08-04 jrmu      (let ((i (car triple))
304 665c255d 2023-08-04 jrmu 	   (j (cadr triple))
305 665c255d 2023-08-04 jrmu 	   (k (caddr triple)))
306 665c255d 2023-08-04 jrmu        (= (square k) (+ (square i) (square j)))))
307 665c255d 2023-08-04 jrmu    (triples integers integers integers)))
308 665c255d 2023-08-04 jrmu 
309 665c255d 2023-08-04 jrmu (define (merge-weighted s1 s2 weight)
310 665c255d 2023-08-04 jrmu   (cond ((stream-null? s1) s2)
311 665c255d 2023-08-04 jrmu 	((stream-null? s2) s1)
312 665c255d 2023-08-04 jrmu 	(else
313 665c255d 2023-08-04 jrmu 	 (let ((s1car (stream-car s1))
314 665c255d 2023-08-04 jrmu 	       (s2car (stream-car s2)))
315 665c255d 2023-08-04 jrmu 	       (if (<= (weight s1car) (weight s2car))
316 665c255d 2023-08-04 jrmu 		   (cons-stream
317 665c255d 2023-08-04 jrmu 		    s1car
318 665c255d 2023-08-04 jrmu 		    (merge-weighted (stream-cdr s1) s2 weight))
319 665c255d 2023-08-04 jrmu 		   (cons-stream
320 665c255d 2023-08-04 jrmu 		    s2car
321 665c255d 2023-08-04 jrmu 		    (merge-weighted s1 (stream-cdr s2) weight)))))))
322 665c255d 2023-08-04 jrmu 
323 665c255d 2023-08-04 jrmu (define (weighted-pairs s t weight)
324 665c255d 2023-08-04 jrmu   (cons-stream 
325 665c255d 2023-08-04 jrmu    (list (stream-car s) (stream-car t))
326 665c255d 2023-08-04 jrmu    (merge-weighted
327 665c255d 2023-08-04 jrmu     (stream-map
328 665c255d 2023-08-04 jrmu      (lambda (x)
329 665c255d 2023-08-04 jrmu        (list (stream-car s) x))
330 665c255d 2023-08-04 jrmu      (stream-cdr t))
331 665c255d 2023-08-04 jrmu     (weighted-pairs (stream-cdr s) (stream-cdr t) weight)
332 665c255d 2023-08-04 jrmu     weight)))
333 665c255d 2023-08-04 jrmu 
334 665c255d 2023-08-04 jrmu (define (integral integrand initial-value dt)
335 665c255d 2023-08-04 jrmu   (define int
336 665c255d 2023-08-04 jrmu     (cons-stream initial-value
337 665c255d 2023-08-04 jrmu 		 (add-streams (scale-stream integrand dt)
338 665c255d 2023-08-04 jrmu 			      int)))
339 665c255d 2023-08-04 jrmu   int)
340 665c255d 2023-08-04 jrmu 
341 665c255d 2023-08-04 jrmu (define (list->stream list)
342 665c255d 2023-08-04 jrmu   (if (null? list)
343 665c255d 2023-08-04 jrmu       the-empty-stream
344 665c255d 2023-08-04 jrmu       (cons-stream (car list)
345 665c255d 2023-08-04 jrmu 		   (list->stream (cdr list)))))
346 665c255d 2023-08-04 jrmu 
347 665c255d 2023-08-04 jrmu (define (solve f y0 dt)
348 665c255d 2023-08-04 jrmu   (define y (integral (mydelay dy) y0 dt))
349 665c255d 2023-08-04 jrmu   (define dy (stream-map f y))
350 665c255d 2023-08-04 jrmu   y)
351 665c255d 2023-08-04 jrmu 
352 665c255d 2023-08-04 jrmu (define (integral delayed-integrand initial-value dt)
353 665c255d 2023-08-04 jrmu   (define int
354 665c255d 2023-08-04 jrmu     (cons-stream initial-value
355 665c255d 2023-08-04 jrmu 		 (let ((integrand (myforce delayed-integrand)))
356 665c255d 2023-08-04 jrmu 		   (add-streams (scale-stream integrand dt)
357 665c255d 2023-08-04 jrmu 				int))))
358 665c255d 2023-08-04 jrmu   int)
359 665c255d 2023-08-04 jrmu 
360 665c255d 2023-08-04 jrmu ;; (define rand
361 665c255d 2023-08-04 jrmu ;;   (let ((x random-init))
362 665c255d 2023-08-04 jrmu ;;     (lambda ()
363 665c255d 2023-08-04 jrmu ;;       (set! x (rand-update x))
364 665c255d 2023-08-04 jrmu ;;       x)))
365 665c255d 2023-08-04 jrmu 
366 665c255d 2023-08-04 jrmu ;; (define (rand-update x)
367 665c255d 2023-08-04 jrmu ;;   (let ((a (expt 2 32))
368 665c255d 2023-08-04 jrmu ;; 	(c 1103515245)
369 665c255d 2023-08-04 jrmu ;; 	(m 12345))
370 665c255d 2023-08-04 jrmu ;;     (modulo (+ (* a x) c) m)))
371 665c255d 2023-08-04 jrmu ;; (define random-init 137)
372 665c255d 2023-08-04 jrmu 
373 665c255d 2023-08-04 jrmu (define random-init 317)
374 665c255d 2023-08-04 jrmu (define (rand-update x)
375 665c255d 2023-08-04 jrmu   (random (expt 2 31)))
376 665c255d 2023-08-04 jrmu 
377 665c255d 2023-08-04 jrmu (define random-numbers
378 665c255d 2023-08-04 jrmu   (cons-stream random-init
379 665c255d 2023-08-04 jrmu 	       (stream-map rand-update random-numbers)))
380 665c255d 2023-08-04 jrmu (define (map-successive-pairs f s)
381 665c255d 2023-08-04 jrmu   (cons-stream
382 665c255d 2023-08-04 jrmu    (f (stream-car s) (stream-car (stream-cdr s)))
383 665c255d 2023-08-04 jrmu    (map-successive-pairs f (stream-cdr (stream-cdr s)))))
384 665c255d 2023-08-04 jrmu 
385 665c255d 2023-08-04 jrmu (define cesaro-stream
386 665c255d 2023-08-04 jrmu   (map-successive-pairs (lambda (r1 r2) (= (gcd r1 r2) 1))
387 665c255d 2023-08-04 jrmu 			random-numbers))
388 665c255d 2023-08-04 jrmu 
389 665c255d 2023-08-04 jrmu (define (monte-carlo experiment-stream passed failed)
390 665c255d 2023-08-04 jrmu   (define (next passed failed)
391 665c255d 2023-08-04 jrmu     (cons-stream
392 665c255d 2023-08-04 jrmu      (/ passed (+ passed failed))
393 665c255d 2023-08-04 jrmu      (monte-carlo 
394 665c255d 2023-08-04 jrmu       (stream-cdr experiment-stream) passed failed)))
395 665c255d 2023-08-04 jrmu   (if (stream-car experiment-stream)
396 665c255d 2023-08-04 jrmu       (next (+ passed 1) failed)
397 665c255d 2023-08-04 jrmu       (next passed (+ failed 1))))
398 665c255d 2023-08-04 jrmu 
399 665c255d 2023-08-04 jrmu (define pi
400 665c255d 2023-08-04 jrmu   (stream-map (lambda (p) (sqrt (/ 6 p)))
401 665c255d 2023-08-04 jrmu 	      (monte-carlo cesaro-stream 0 0)))
402 665c255d 2023-08-04 jrmu (display-streams 10000 pi)