Streams from SICP

streams.scm

; SICP 3.5 Streams

; constraints :-
; (stream-car (cons-stream x y)) = x
; (stream-cdr (cons-stream x y)) = y

(define the-empty-stream '())

(define stream-null? null?)

(define (stream-ref s n)
  (if (= n 0)
      (stream-car s)
      (stream-ref (stream-cdr s) (- n 1))))

(define (stream-enumerate-interval low high)
  (if (> low high)
      the-empty-stream
      (cons-stream
        low
        (stream-enumerate-interval (+ low 1) high))))

(define (stream-map proc s)
  (if (stream-null? s)
      the-empty-stream
      (cons-stream (proc (stream-car s))
                   (stream-map proc (stream-cdr s)))))

                                ; stream-map allows procedures that
                                ; take multiple values
(define (stream-map proc . argstreams)
  (if (stream-null? (car argstreams))
      the-empty-stream
      (cons-stream
        (apply proc (map stream-car argstreams))
        (apply stream-map
               (cons proc (map stream-cdr argstreams))))))

(define (stream-filter pred s)
  (cond ((stream-null? s) the-empty-stream)
        ((pred (stream-car s))
         (cons-stream (stream-car s)
                      (stream-filter pred
                                     (stream-cdr s))))
        (else (stream-filter pred (stream-cdr s)))))

(define (stream-for-each proc s)
  (if (stream-null? s)
      'done
      (begin (proc (stream-car s))
             (stream-for-each proc (stream-cdr s)))))

(define (display-stream s)
  (stream-for-each display-line s))

(define (display-line x)
  (newline)
  (display x))

(define (show x)
  (display-line x)
  x)

(define (take-stream stream n)
  (if (= n 0)
      '()
      (cons (stream-car stream)
            (take-stream (stream-cdr stream) (- n 1)))))

(define-syntax cons-stream
  (syntax-rules ()
    ((_ x y)
     (cons x (delay y)))))

(define (stream-car s)
  (car s))

(define (stream-cdr s)
  (force (cdr s)))

                                ; memoizing delay
                                ; memo-proc takes a procedure of no args
                                ; and memoizes the result
(define (memo-proc proc)
  (let ((already-run? #f) (result #f))
    (lambda ()
      (if (not-already-run?)
          (begin (set! result (proc))
                 (set! already-run? #t)
                 result)
          result))))

                                ; (delay <exp>) 
                                ; -> (memo-proc (lambda () <exp>))
(define-syntax my-delay
  (syntax-rules ()
    ((_ e) (memo-proc (lambda () e)))))

; Infinite sequences
                                ; A stream of infinite integers
(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

(define integers (integers-starting-from 1))

                                ; An infinite stream of integers not
                                ; divisible by 7
(define (divisible? x y)
  (= (remainder x y) 0))

(define no-sevens
  (stream-filter (lambda (x) (not (divisible? x 7)))
                 integers))

                                ; An infinite stream of fibonacci numbers
(define (fibgen a b)
  (cons-stream a (fibgen b (+ a b))))

(define fibs (fibgen 0 1))

                                ; Sieve of Eratosthenes
                                ; To sieve a stream S, form a stream whose first
                                ; element is the first element of S and the rest
                                ; of which is obtained by filtering all multiples
                                ; of the first element of S out of the rest of S
                                ; and sieving the result
(define (sieve stream)
  (cons-stream
    (stream-car stream)
    (sieve (stream-filter
             (lambda (x)
               (not (divisible? x (stream-car stream))))
             (stream-cdr stream)))))

(define primes (sieve (integers-starting-from 2)))

; Infinite streams implicitly

                                ; An infinte stream of ones
(define ones (cons-stream 1 ones))

                                ; add-streams : elementwise sum of two given streams
(define (add-streams s1 s2)
  (stream-map + s1 s2))

                                ; alternate definition of integers
(define integers (cons-stream 1 (add-streams ones integers)))

                                ; alternate definition of fibonacci stream
(define fibs
  (cons-stream 0
               (cons-stream 1
                            (add-streams (stream-cdr fibs)
                                         fibs))))

                                ; scale a stream
(define (scale-stream stream factor)
  (stream-map (lambda (x) (* x factor)) stream))

                                ; a stream of powers of 2
(define double
  (cons-stream 1 (scale-stream double 2)))

                                ; Ex. 3.54: mul-streams & factorials
(define (mul-streams s1 s2)
  (stream-map * s1 s2))

(define factorials (cons-stream 1 (mul-streams 
                                    (stream-cdr integers) factorials)))

                                ; Ex. 3.55: partial-sums
                                ; partial-sums takes as argument a stream S and returns
                                ; the stream whose elements are S0, S0 + S1, S0 + S1 + S2
                                ; and so on
(define (partial-sums stream)
  (cons-stream
    (stream-car stream)
    (add-streams
      (partial-sums stream)
      (stream-cdr stream))))

(define (partial-sums stream)
  (add-streams stream (cons-stream 0 (partial-sums stream))))

                                ; Ex. 3.58
(define (expand num den radix)
  (cons-stream
    (quotient (* num radix) den)
    (expand (remainder (* num radix) den) den radix)))

                                ; A stream of iterative guesses for the sqrt of a number
(define (sqrt-stream x)
  (define (average x y)
    (/ (+ x y) 2))
  (define (sqrt-improve guess x)
    (average guess (/ x guess)))
  (define guesses
    (cons-stream 1.0
                 (stream-map (lambda (guess)
                               (sqrt-improve guess x))
                             guesses)))
  guesses)

                                ; An approximation of π
                                ; π/4 = 1 - 1/3 + 1/5 - 1/7 + ...
(define (pi-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (pi-summands (+ n 2)))))

(define pi-stream
  (scale-stream (partial-sums (pi-summands 1)) 4))

                                ; Euler transform of a sequence
                                ; (euler-transform pi-stream) converges faster than pi-stream
                                ; this "accelerates" a sequence of approximations
(define (euler-transform s)
  (let ((s0 (stream-ref s 0))
        (s1 (stream-ref s 1))
        (s2 (stream-ref s 2)))
    (cons-stream (- s2 (/ (square (- s2 s1))
                          (+ s0 (* -2 s1) s2)))
                 (euler-transform (stream-cdr s)))))

                                ; Tableau -- A stream of streams
                                ; s₀₀ s₀₁ s₀₂ s₀₃ s₀₄ ...
                                ;     s₁₀ s₁₁ s₁₂ s₁₃ ...
                                ;         s₂₀ s₂₁ s₂₂ ...
                                ;                 ...
(define (make-tableau transform s)
  (cons-stream s
               (make-tableau transform
                             (transform s))))

                                ; first term in each row of the tableau
(define (accelerated-sequence transform s)
  (stream-map stream-car
              (make-tableau transform s)))

                                ; Ex. 3.64: stream-limit
(define (stream-limit-helper stream tolerance n)
  (let ((s0 (stream-car stream))
        (s1 (stream-car (stream-cdr stream))))
    (if (< (abs (- s1 s0)) tolerance)
        (list s0 n)
        (stream-limit-helper (stream-cdr stream) tolerance (+ n 1)))))

(define (stream-limit stream tolerance)
  (stream-limit-helper stream tolerance 0))

(define (my-sqrt x tolerance)
  (stream-limit (sqrt-stream x) tolerance))

                                ; Ex. 3.65: approximate ln 2
(define (ln2-summands n)
  (cons-stream (/ 1.0 n)
               (stream-map - (ln2-summands (+ n 1)))))

(define ln2-stream
  (partial-sums (ln2-summands 1)))


                                ; Infinite pairs
(define (pairs s t)
  (cons-stream
    (list (stream-car s) (stream-car t))
    (interleave
      (stream-map (lambda (x) (list (stream-car s) x))
                  (stream-cdr t))
      (pairs (stream-cdr s) (stream-cdr t)))))

                                ; There should be a function f of two arguments
                                ; such that the pair corresponding to element i
                                ; of the first stream and element j of the second
                                ; stream will appear as element f(i,j) of the
                                ; output stream
(define (interleave s1 s2)
  (if (stream-null? s1)
      s2
      (cons-stream (stream-car s1)
                   (interleave s2 (stream-cdr s1))))) ; particularly elegant


                                ; Ex. 3.67: modify pairs to so that (pairs ints ints)
                                ; will produce ALL pairs of integers (i j) without
                                ; the condition that i <= j
(define (all-pairs s t)
  (cons-stream
    (list (stream-car s) (stream-car t))
    (interleave
      (interleave
        (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t))
        (stream-map (lambda (x) (list x (stream-car t))) (stream-cdr s)))
      (pairs (stream-cdr s) (stream-cdr t)))))

                                ; Ex. 3.68: Louis Reasoner's pairs function
                                ; Results in an infinite loop since `interleave`
                                ; has to fully evaluate the expression
                                ; (louis-pairs (stream-cdr s) (stream-cdr t))
                                ; wrapping everything in a `cons-stream` won't
                                ; cause this issue since `cons-stream` delays
                                ; the evaluation of its second argument
(define (louis-pairs s t)
  (interleave
    (stream-map (lambda (x) (list (stream-car s) x)) t)
    (louis-pairs (stream-cdr s) (stream-cdr t))))

                                ; Ex. 3.69: triples takes three infinite streams
                                ; S, T, and U, and produces the stream of triples
                                ; (Si, Tj, Uk) such that i <= j <= k.
(define (triples s t u)
  (cons-stream 
    (list (stream-car s) (stream-car t) (stream-car u))
    (interleave 
      (stream-map (lambda (x) (cons (stream-car s) x))
                  (stream-cdr (pairs t u)))
      (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))

(define (triples s t u)
  (cons-stream
    (map stream-car (list s t u))
    (interleave
      (stream-map (lambda (x) (cons (stream-car s) x))
                  (stream-cdr (pairs t u)))
      (apply triples (map stream-cdr (list s t u))))))

(define (pythagorean-condition x y z)
  (= (+ (* x x) (* y y)) (* z z)))

(define pythagorean-triplets
  (stream-filter (lambda (x) (apply pythagorean-condition x)) 
                 (triples integers integers integers)))