src/sicp/streams.rkt

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