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))
87 665c255d 2023-08-04 jrmu (define no-sevens
88 665c255d 2023-08-04 jrmu (stream-filter (lambda (x) (not (divisible? x 7)))
91 665c255d 2023-08-04 jrmu (define (fibgen a b)
92 665c255d 2023-08-04 jrmu (cons-stream a (fibgen b (+ a b))))
93 665c255d 2023-08-04 jrmu (define fibs (fibgen 0 1))
95 665c255d 2023-08-04 jrmu (define (sieve s)
96 665c255d 2023-08-04 jrmu (cons-stream
97 665c255d 2023-08-04 jrmu (stream-car s)
98 665c255d 2023-08-04 jrmu (sieve (stream-filter
100 665c255d 2023-08-04 jrmu (not (divisible? x (stream-car s))))
101 665c255d 2023-08-04 jrmu (stream-cdr s)))))
103 665c255d 2023-08-04 jrmu ;; (define primes (sieve (integers-starting-from 2)))
104 665c255d 2023-08-04 jrmu ;; (test-case (stream-ref primes 25) 101)
106 665c255d 2023-08-04 jrmu (define ones (cons-stream 1 ones))
107 665c255d 2023-08-04 jrmu (define (add-streams s1 s2)
108 665c255d 2023-08-04 jrmu (stream-map + s1 s2))
109 665c255d 2023-08-04 jrmu (define integers (cons-stream 1 (add-streams ones integers)))
110 665c255d 2023-08-04 jrmu ;; (test-case (stream-ref integers 15) 16)
112 665c255d 2023-08-04 jrmu (define fibs
113 665c255d 2023-08-04 jrmu (cons-stream 0
114 665c255d 2023-08-04 jrmu (cons-stream 1
115 665c255d 2023-08-04 jrmu (add-streams (stream-cdr fibs)
118 665c255d 2023-08-04 jrmu (define (scale-stream stream factor)
119 665c255d 2023-08-04 jrmu (stream-map (lambda (x)
120 665c255d 2023-08-04 jrmu (* x factor))
122 665c255d 2023-08-04 jrmu (define double (cons-stream 1 (scale-stream double 2)))
124 665c255d 2023-08-04 jrmu (define primes
125 665c255d 2023-08-04 jrmu (cons-stream
127 665c255d 2023-08-04 jrmu (stream-filter prime? (integers-starting-from 3))))
128 665c255d 2023-08-04 jrmu (define (prime? n)
129 665c255d 2023-08-04 jrmu (define (iter ps)
130 665c255d 2023-08-04 jrmu (cond ((> (square (stream-car ps)) n) true)
131 665c255d 2023-08-04 jrmu ((divisible? n (stream-car ps)) false)
132 665c255d 2023-08-04 jrmu (else (iter (stream-cdr ps)))))
133 665c255d 2023-08-04 jrmu (iter primes))
135 665c255d 2023-08-04 jrmu (define (mul-streams s1 s2)
136 665c255d 2023-08-04 jrmu (stream-map * s1 s2))
138 665c255d 2023-08-04 jrmu (define (partial-sums s)
139 665c255d 2023-08-04 jrmu (define sums
140 665c255d 2023-08-04 jrmu (cons-stream (stream-car s)
141 665c255d 2023-08-04 jrmu (add-streams sums
142 665c255d 2023-08-04 jrmu (stream-cdr s))))
145 665c255d 2023-08-04 jrmu (define (merge s1 s2)
146 665c255d 2023-08-04 jrmu (cond ((stream-null? s1) s2)
147 665c255d 2023-08-04 jrmu ((stream-null? s2) s1)
149 665c255d 2023-08-04 jrmu (let ((s1car (stream-car s1))
150 665c255d 2023-08-04 jrmu (s2car (stream-car s2)))
151 665c255d 2023-08-04 jrmu (cond ((< s1car s2car)
152 665c255d 2023-08-04 jrmu (cons-stream
154 665c255d 2023-08-04 jrmu (merge (stream-cdr s1) s2)))
155 665c255d 2023-08-04 jrmu ((> s1car s2car)
156 665c255d 2023-08-04 jrmu (cons-stream
158 665c255d 2023-08-04 jrmu (merge s1 (stream-cdr s2))))
160 665c255d 2023-08-04 jrmu (cons-stream
162 665c255d 2023-08-04 jrmu (merge (stream-cdr s1) (stream-cdr s2)))))))))
164 665c255d 2023-08-04 jrmu (define (test-stream-list stream list)
165 665c255d 2023-08-04 jrmu (if (null? list)
167 665c255d 2023-08-04 jrmu (begin (display "A: ")
168 665c255d 2023-08-04 jrmu (display (stream-car stream))
169 665c255d 2023-08-04 jrmu (display " -- ")
170 665c255d 2023-08-04 jrmu (display "E: ")
171 665c255d 2023-08-04 jrmu (display (car list))
173 665c255d 2023-08-04 jrmu (test-stream-list (stream-cdr stream) (cdr list)))))
175 665c255d 2023-08-04 jrmu (define (integrate-series a)
176 665c255d 2023-08-04 jrmu (stream-map / a integers))
178 665c255d 2023-08-04 jrmu (define exp-series
179 665c255d 2023-08-04 jrmu (cons-stream 1 (integrate-series exp-series)))
181 665c255d 2023-08-04 jrmu (define cosine-series
182 665c255d 2023-08-04 jrmu (cons-stream
184 665c255d 2023-08-04 jrmu (integrate-series (stream-map - sine-series))))
185 665c255d 2023-08-04 jrmu (define sine-series
186 665c255d 2023-08-04 jrmu (cons-stream
188 665c255d 2023-08-04 jrmu (integrate-series cosine-series)))
190 665c255d 2023-08-04 jrmu (define (mul-series s1 s2)
191 665c255d 2023-08-04 jrmu (cons-stream
192 665c255d 2023-08-04 jrmu (* (stream-car s1) (stream-car s2))
193 665c255d 2023-08-04 jrmu (add-streams
194 665c255d 2023-08-04 jrmu (scale-stream (stream-cdr s2) (stream-car s1))
195 665c255d 2023-08-04 jrmu (mul-series (stream-cdr s1) s2))))
197 665c255d 2023-08-04 jrmu ;; Exercise 3.61. Let S be a power series (exercise 3.59) whose constant term is 1. Suppose we want to find the power series 1/S, that is, the series X such that S · X = 1. Write S = 1 + SR where SR is the part of S after the constant term. Then we can solve for X as follows:
199 665c255d 2023-08-04 jrmu ;; X = 1 - SR·X
201 665c255d 2023-08-04 jrmu ;; In other words, X is the power series whose constant term is 1 and whose higher-order terms are given by the negative of SR times X. Use this idea to write a procedure invert-unit-series that computes 1/S for a power series S with constant term 1. You will need to use mul-series from exercise 3.60.
203 665c255d 2023-08-04 jrmu (define (invert-unit-series s)
205 665c255d 2023-08-04 jrmu (cons-stream
207 665c255d 2023-08-04 jrmu (mul-series (stream-map - (stream-cdr s))
211 665c255d 2023-08-04 jrmu ;; Exercise 3.62. Use the results of exercises 3.60 and 3.61 to define a procedure div-series that divides two power series. Div-series should work for any two series, provided that the denominator series begins with a nonzero constant term. (If the denominator has a zero constant term, then div-series should signal an error.) Show how to use div-series together with the result of exercise 3.59 to generate the power series for tangent.
213 665c255d 2023-08-04 jrmu (define (div-series num den)
214 665c255d 2023-08-04 jrmu (let ((den-car (stream-car den)))
215 665c255d 2023-08-04 jrmu (if (zero? den-car)
216 665c255d 2023-08-04 jrmu (error "Denominator has zero constant term -- DIV-SERIES")
217 665c255d 2023-08-04 jrmu (scale-stream
218 665c255d 2023-08-04 jrmu (mul-series
220 665c255d 2023-08-04 jrmu (invert-unit-series (scale-stream den (/ 1 den-car))))
221 665c255d 2023-08-04 jrmu (/ 1 den-car)))))
223 665c255d 2023-08-04 jrmu (define tangent-series (div-series sine-series cosine-series))
224 665c255d 2023-08-04 jrmu (test-stream-list
225 665c255d 2023-08-04 jrmu tangent-series
226 665c255d 2023-08-04 jrmu '(0 1 0 1/3 0 2/15 0 17/315 0 62/2835))
