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)