| blob | 6cf56fa18443b1a72bcb3b77b7855cc0e0c750b3 |
1 (module streams mzscheme\r
2 (require (lib "defmacro.ss"))\r
3 \r
4 (provide (all-defined))\r
5 \r
6 (define ... 'not-implemented)\r
7 \r
8 (define (square x)\r
9 (* x x))\r
10 \r
11 ; the empty stream\r
12 (define the-empty-stream '())\r
13 \r
14 ; empty-stream? object -> boolean\r
15 (define empty-stream? null?)\r
16 (define stream-null? empty-stream?)\r
17 (define empty? empty-stream?)\r
18 \r
19 (define-macro cons-stream\r
20 (lambda (car cdr)\r
21 `(cons ,car (delay ,cdr))))\r
22 \r
23 (define (stream-car stream)\r
24 (car stream))\r
25 \r
26 (define (stream-cdr stream)\r
27 (force (cdr stream)))\r
28 \r
29 (define (stream-ref s n)\r
30 (if (= n 0)\r
31 (stream-car s)\r
32 (stream-ref (stream-cdr s) (- n 1))))\r
33 \r
34 (define (stream->list s n)\r
35 (if (= n 0)\r
36 '()\r
37 (if (not (empty? s))\r
38 (cons (stream-car s)\r
39 (stream->list (stream-cdr s) (- n 1)))\r
40 '())))\r
41 \r
42 ; Higher order\r
43 \r
44 (define (stream-map proc . streams)\r
45 (if (stream-null? (car streams))\r
46 the-empty-stream\r
47 (cons-stream\r
48 (apply proc (map stream-car streams))\r
49 (apply stream-map\r
50 (cons proc (map stream-cdr streams))))))\r
51 \r
52 (define (stream-for-each proc s)\r
53 (if (stream-null? s)\r
54 'done\r
55 (begin (proc (stream-car s))\r
56 (stream-for-each proc (stream-cdr s)))))\r
57 \r
58 (define (stream-filter predicate stream)\r
59 (cond\r
60 [(empty? stream) the-empty-stream]\r
61 [(predicate (stream-car stream)) (cons-stream (stream-car stream)\r
62 (stream-filter predicate\r
63 (stream-cdr stream)))]\r
64 [else (stream-filter predicate (stream-cdr\r
65 stream))]))\r
66 \r
67 ; combining\r
68 \r
69 (define (merge s1 s2)\r
70 (cond\r
71 [(empty? s1) s2]\r
72 [(empty? s2) s1]\r
73 [else (let ([s1car (stream-car s1)]\r
74 [s2car (stream-car s2)])\r
75 (cond\r
76 [(< s1car s2car) (cons-stream s1car (merge (stream-cdr s1)\r
77 s2))]\r
78 [else (cons-stream s2car (merge (stream-cdr s2)\r
79 s1))]))]))\r
80 \r
81 \r
82 \r
83 \r
84 ;;; Aritmetical\r
85 \r
86 (define (add-streams s1 s2)\r
87 (stream-map + s1 s2))\r
88 \r
89 (define (mul-streams s1 s2)\r
90 (stream-map * s1 s2))\r
91 \r
92 (define (scale-stream k s)\r
93 (stream-map (lambda (x) (* k x))\r
94 s))\r
95 \r
96 (define (constant-stream c)\r
97 (scale-stream c ones))\r
98 \r
99 (define (partial-sums s)\r
100 (cons-stream (stream-car s)\r
101 (add-streams (constant-stream (stream-car s))\r
102 (partial-sums (stream-cdr s)))))\r
103 \r
104 \r
105 ; Output\r
106 \r
107 (define (display-stream s)\r
108 (stream-for-each display-line s))\r
109 \r
110 (define (display-line x)\r
111 (newline)\r
112 (display x))\r
113 \r
114 ;;; Numbers\r
115 \r
116 (define (stream-interval low high)\r
117 (if (> low high)\r
118 the-empty-stream\r
119 (cons-stream low\r
120 (stream-interval (+ low 1) high))))\r
121 \r
122 (define (integers-starting-from n)\r
123 (cons-stream n (integers-starting-from (+ n 1))))\r
124 \r
125 \r
126 ;;; Primes\r
127 \r
128 ; Sieve if Eratosthenes\r
129 (define (sieve stream)\r
130 (cons-stream (stream-car stream)\r
131 (sieve (stream-filter (lambda (x)\r
132 (not (= (remainder x (stream-car\r
133 stream)) 0)))\r
134 (stream-cdr stream)))))\r
135 \r
136 (define primes (sieve (integers-starting-from 2)))\r
137 (define (prime? n)\r
138 (let loop ([s primes])\r
139 (cond\r
140 [(< n (stream-car s)) #f]\r
141 [(= n (stream-car s)) #t]\r
142 [else (loop (stream-cdr s))])))\r
143 \r
144 ; fractions\r
145 \r
146 ; returns the sequence of digits of num/den expressed in radix\r
147 (define (expand-1 num den radix)\r
148 (cons-stream (quotient (* num radix) den)\r
149 (expand-1 (remainder (* num radix) den) den radix)))\r
150 \r
151 ; Power Series\r
152 \r
153 ; remember to cons an constant term after integration\r
154 (define (integrate-series s)\r
155 (stream-map * s inverses))\r
156 \r
157 (define exp-series (cons-stream 1 (integrate-series exp-series)))\r
158 (define cos-series (cons-stream 1 (scale-stream -1 (integrate-series\r
159 sin-series))))\r
160 (define sin-series (cons-stream 0 (integrate-series sin-series)))\r
161 \r
162 (define (mul-series s1 s2)\r
163 (cons-stream (* (stream-car s1) (stream-car s2))\r
164 (add-streams (scale-stream (stream-car s1) s2)\r
165 (scale-stream (stream-car s2) s1)\r
166 (mul-series (stream-cdr s1) (stream-cdr s2)))))\r
167 \r
168 ; Limits\r
169 \r
170 (define (average x y)\r
171 (/ (+ x y) 2))\r
172 \r
173 (define (sqrt-improve guess x)\r
174 (average guess (/ x guess)))\r
175 \r
176 (define (sqrt-stream x)\r
177 (letrec ([guesses (cons-stream 1.0\r
178 (stream-map (lambda (guess)\r
179 (sqrt-improve guess x))\r
180 guesses))])\r
181 guesses))\r
182 \r
183 (define (pi-summands n)\r
184 (cons-stream (/ 1.0 n)\r
185 (stream-map - (pi-summands (+ n 2)))))\r
186 \r
187 (define pi-stream (scale-stream 4 (partial-sums (pi-summands 1))))\r
188 \r
189 \r
190 ; Euler accelerator\r
191 \r
192 (define (euler-transform s)\r
193 (let ([s0 (stream-ref s 0)]\r
194 [s1 (stream-ref s 1)]\r
195 [s2 (stream-ref s 2)])\r
196 (cons-stream (- s2 (/ (square (- s2 s1))\r
197 (+ s0 (* -2 s1) s2)))\r
198 (euler-transform (stream-cdr s)))))\r
199 \r
200 (define (make-tableau transform s)\r
201 (cons-stream s\r
202 (make-tableau transform\r
203 (transform s))))\r
204 \r
205 (define (accelerated-sequence transform s)\r
206 (stream-map stream-car\r
207 (make-tableau transform s)))\r
208 \r
209 \r
210 \r
211 ; Sequences\r
212 \r
213 (define ones (cons-stream 1 ones))\r
214 (define integers (integers-starting-from 1))\r
215 (define integers2 (cons-stream 1 (add-streams ones integers2)))\r
216 (define inverses (stream-map (lambda (x) (/ 1 x)) integers))\r
217 \r
218 (define fibonacci (cons-stream 0\r
219 (cons-stream 1\r
220 (add-streams fibonacci\r
221 (stream-cdr\r
222 fibonacci)))))\r
223 (define factorials (cons-stream 1\r
224 (mul-streams integers factorials)))\r
225 \r
226 )