]> git.rkrishnan.org Git - sicp.git/blob - src/sicp/streams.rkt
Solution to 4.44. A bit too verbose. Can be improved by better
[sicp.git] / src / sicp / streams.rkt
1 #lang planet neil/sicp
2
3 (#%require (only racket random))
4
5 (define (stream-car s) (car s))
6 (define (stream-cdr s) (force (cdr s)))
7
8 (define (stream-ref s n)
9   (if (= n 0)
10       (stream-car s)
11       (stream-ref (stream-cdr s)
12                   (- n 1))))
13
14 (define (stream-map proc . argstreams)
15   (if (stream-null? (car argstreams))
16       the-empty-stream
17       (cons-stream
18        (apply proc (map stream-car argstreams))
19        (apply stream-map
20               (cons proc (map stream-cdr argstreams))))))
21
22 (define (scale-stream stream factor)
23   (stream-map (lambda (x) (* x factor)) stream))
24
25 #|
26 (define (stream-map proc s)
27   (if (stream-null? s)
28       the-empty-stream
29       (cons-stream (proc (stream-car s))
30                    (stream-map proc (stream-cdr s)))))
31 |#
32
33 (define (stream-filter pred? s)
34   (cond [(stream-null? s) the-empty-stream]
35         [(pred? (stream-car s))
36          (cons-stream (stream-car s)
37                       (stream-filter pred? (stream-cdr s)))]
38         [else (stream-filter pred? (stream-cdr s))]))
39
40 (define (stream-for-each proc s)
41   (if (stream-null? s)
42       'done
43       (begin
44         (proc (stream-car s))
45         (stream-for-each proc (stream-cdr s)))))
46
47 (define (display-stream s)
48   (stream-for-each display-line s))
49
50 (define (display-line x)
51   (newline)
52   (display x))
53
54 ;; stream-enumerate-interval
55 (define (stream-enumerate-interval low high)
56   (if (> low high)
57       the-empty-stream
58       (cons-stream low
59                    (stream-enumerate-interval (+ low 1)
60                                               high))))
61
62
63 ;; prime?
64 (define (square x) (* x x))
65 (define (smallest-divisor n)
66   (find-divisor n 2))
67 (define (find-divisor n test-divisor)
68   (cond ((> (square test-divisor) n) n)
69         ((divides? test-divisor n) test-divisor)
70         (else (find-divisor n (+ test-divisor 1)))))
71 (define (divides? a b)
72   (= (remainder b a) 0))
73
74 (define (prime? n)
75   (= (smallest-divisor n) n))
76
77
78 ;; infinite streams
79 (define (integers-starting-from n)
80   (cons-stream n
81                (integers-starting-from (+ n 1))))
82
83 (define integers (integers-starting-from 1))
84
85 (define (add-streams s1 s2)
86   (stream-map + s1 s2))
87
88 ;; integers which are not a multiple of 7
89 (define (divisible? a b) (= 0 (remainder a b)))
90
91 (define no-sevens
92   (stream-filter (lambda (x) (not (divisible? x 7)))
93                  integers))
94
95 ;; fibonaci
96 (define (fib-gen a b)
97   (cons-stream a (fib-gen b (+ a b))))
98
99 (define fibs (fib-gen 0 1))
100
101 ;; sieve
102 (define (sieve stream)
103   (cons-stream
104    (stream-car stream)
105    (sieve (stream-filter (lambda (x) 
106                            (not (divisible? x (stream-car stream))))
107                          (stream-cdr stream)))))
108                
109 (define primes (sieve (integers-starting-from 2)))
110
111 (define (interleave s1 s2)
112   (if (stream-null? s1)
113       s2
114       (cons-stream (stream-car s1)
115                    (interleave s2 (stream-cdr s1)))))
116
117 (define (pairs s t)
118   (cons-stream
119    (list (stream-car s) (stream-car t))
120    (interleave
121     (stream-map (lambda (x) (list (stream-car s) x))
122                 (stream-cdr t))
123     (pairs (stream-cdr s) (stream-cdr t)))))
124
125 (define (integral integrand initial-value dt)
126   (define int
127     (cons-stream initial-value
128                  (add-streams (scale-stream integrand dt)
129                               int)))
130   int)