CprS376 Schedule
CprS376 Class 13
CprS376 Class 15

Streams

Class 14, Section 3.5



Contents

Stream ADT

;; streamADT-SICP.ss

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;;   streams for the SICP QUERY SYSTEM
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;; the SICP stream ADT is based on five definitions:

;     stream-car
;     stream-cdr
;     cons-stream
;     the-empty-stream
;     stream-null?

;; we assume that the underlying Scheme implementation supports force and delay

(define compose
  (lambda (f g)
    (lambda (x)
      (f (g x)))))

(define stream-car 
  (compose car force))

(define stream-cdr 
  (compose cdr force))

(extend-syntax (cons-stream)
               ((cons-stream expr stream) 
                (delay (cons expr stream))))

(define the-end-of-stream-tag "end of stream")

(define the-empty-stream
  (cons-stream the-end-of-stream-tag the-empty-stream))

(define stream-null?
  (let ((end-of-stream?
          (lambda (x)
            (eq? x the-end-of-stream-tag))))
    (compose end-of-stream? stream-car)))


;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; coercions
;;     based on three utilities from Friedman, Wand, and Haynes, 
;;     "Scheme and the Art of Programming," Chapter 15, pages 484-485
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;; list->stream

(define list->stream
  (lambda (ls)
    (if (null? ls)
      the-empty-stream
      (cons-stream (car ls)
                   (list->stream (cdr ls))))))

;; stream->list

(define stream->list
  (lambda (strm n)
    (if (or (stream-null? strm) (zero? n))
        '()
        (cons (stream-car strm)
              (stream->list (stream-cdr strm) (sub1 n))))))

;; finite-stream->list

(define finite-stream->list
  (lambda (finite-stream)
    (stream->list finite-stream -1)))

;; compatibility

(define true #t)
(define false #f)

Streams

;; streams-SICP.ss

;; =============================

;; load source code for the stream ADT

(load "streamADT-SICP.ss")

;; load procedures for working with prime numbers
;; for some of the stream examples

(load "primes.ss")

;; =============================

;;;SECTION 3.5

;;;SECTION 3.5.1

(define (sum-primes a b)
  (define (iter count accum)
    (cond ((> count b) accum)
          ((prime? count) (iter (+ count 1) (+ count accum)))
          (else (iter (+ count 1) accum))))
  (iter a 0))


(define (sum-primes a b)
  (accumulate +
              0
              (filter prime? (enumerate-interval a b))))

;: (car (cdr (filter prime?
;:                   (enumerate-interval 10000 1000000))))

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

; (define (stream-map proc . argstreams)
;   (if ( (car argstreams))
;       the-empty-stream
;       (
;        (apply proc (map  argstreams))
;        (apply stream-map
;               (cons proc (map  argstreams))))))

(define (stream-map proc s)
  (if (stream-null? s)
      the-empty-stream
      (cons-stream (proc (stream-car s))
                   (stream-map proc (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))


;; stream-car and stream-cdr would normally be built into
;;  the stream implementation
;; (define (stream-car stream) (car stream))
;; (define (stream-cdr stream) (force (cdr stream)))

;: (stream-car
;:  (stream-cdr
;:   (stream-filter prime?
;:                  (stream-enumerate-interval 10000 1000000))))

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

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


;; force would normally be built into
;;  the stream implementation
;: (define (force delayed-object)
;:   (delayed-object))

(define (memo-proc proc)
  (let ((already-run? false) (result false))
    (lambda ()
      (if (not already-run?)
          (begin (set! result (proc))
                 (set! already-run? true)
                 result)
          result))))


;; EXERCISE 3.51

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

;; (finite-stream->list (stream-enumerate-interval 1 10))
;: (define x (stream-map show (stream-enumerate-interval 0 10)))
;: (stream-ref x 5)
;: (stream-ref x 7)


;; EXERCISE 3.52

(define sum 0)

(define (accum x)
  (set! sum (+ x sum))
  sum)

;; accum
;; <cp: modified to do the right thing at the end of a steam>

(define accum
  (lambda (x)
    (if (number? x)
        (begin
          (set! sum (+ x sum))
          sum)
        x)))

;: (define seq (stream-map accum (stream-enumerate-interval 1 20)))
;: (define y (stream-filter even? seq))
;: (define z (stream-filter (lambda (x) (= (remainder x 5) 0)) seq))

;: (stream-ref y 7)
;: (display-stream z)


;;;SECTION 3.5.2

(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

; (stream->list (integers-starting-from 13) 10)
; => (13 14 15 16 17 18 19 20 21 22)

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

; (stream->list integers 10)
; => (1 2 3 4 5 6 7 8 9 10)

(define (divisible? x y) (= (remainder x y) 0))

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

; (stream->list no-sevens 10)
; => (1 2 3 4 5 6 8 9 10 11)

; (stream-ref no-sevens 100)
; => 117

(define (fibgen a b)
  (cons-stream a (fibgen b (+ a b))))

; (stream->list fibonacci 10)
; => (0 1 1 2 3 5 8 13 21 34)

(define (sieve stream)
  (cons-stream
   (stream-car stream)
   (sieve (stream-filter
           (lambda (x)
             (not (divisible? x (stream-car stream))))
           (stream-cdr stream)))))

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

; (stream->list sieved-primes 10)
; => (2 3 5 7 11 13 17 19 23 29)

; (stream-ref sieved-primes 50)
; => 233

;;==========================================

;;;Defining streams implicitly

;; <cp: These definitions come from the text by Springer and Friedman,
;;        "Scheme and the Art of Programming," Chapter 15, pages 488-489>

(define stream-map
  (lambda (proc strm)
    (cons-stream
     (proc (stream-car strm))
     (stream-map proc (stream-cdr strm)))))

(define stream-apply-to-both
   (lambda (proc)
     (letrec
       ((str-app
         (lambda (s1 s2)
           (cons-stream
            (proc (stream-car s1) (stream-car s2))
            (str-app (stream-cdr s1) (stream-cdr s2))))))
       str-app)))

(define stream-plus 
  (stream-apply-to-both +))

(define stream-times 
  (stream-apply-to-both *))

;; Now let's use these Springer-Friedman procedures 
;; to construct some SICP streams

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;Defining streams implicitly

(define ones (cons-stream 1 ones))

;; (stream->list ones 20)

;; <cp: based on the Springer-Friedman procedure stream-apply-to-both,
;;     rather than the generalized stream-map of SICP exercise 3.50 -- see above>

(define add-streams 
  (stream-apply-to-both +))

(define twos (add-streams ones ones))

;; (stream->list twos 20)

(define integers (cons-stream 1 (add-streams ones integers)))

;; (stream->list integers 20)

(define fibs
  (cons-stream 0
	       (cons-stream 1
                             (add-streams (stream-cdr fibs)
                                          fibs))))

;; (stream->list fibs 20)

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

(define double (cons-stream 1 (scale-stream double 2)))

;; (stream->list double 20)

;; =============================================

;; primes again 
;; <cp: additional discussion>
;; first, we obtain obtain the primes by filtering the integers
;; the filter uses the predicate prime? from the file "primes.ss"

(define primes-nonrec
  (cons-stream
   2
   (stream-filter prime? (integers-starting-from 3))))

;; (stream->list primes-nonrec 10)

;; next, we generate the primes via mutually recursive streams
;; this approach relies on Chebyshev's proof of Bertrand's Hypothesis
;; see SICP, page 330, footnote 63

(define primes-rec
  (cons-stream
   2
   (stream-filter prime-rec? (integers-starting-from 3))))

(define (prime-rec? n)
  (define (iter ps)
    (cond ((> (square (stream-car ps)) n) true)
          ((divisible? n (stream-car ps)) false)
          (else (iter (stream-cdr ps)))))
  (iter primes-rec))

(define true #t)

(define false #f)

;; (stream->list primes-rec 10)
;; !!! warning: sounds plausible,
;;              but does not yet work under gambit or chez scheme !!!

;; =============================================

;; EXERCISE 3.53
;: (define s (cons-stream 1 (add-streams s s)))

;; (stream->list s 20)

;; EXERCISE 3.56
(define (merge s1 s2)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((< s1car s2car)
                  (cons-stream s1car (merge (stream-cdr s1) s2)))
                 ((> s1car s2car)
                  (cons-stream s2car (merge s1 (stream-cdr s2))))
                 (else
                  (cons-stream s1car
                               (merge (stream-cdr s1)
                                      (stream-cdr s2)))))))))


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


;; EXERCISE 3.59
;: (define exp-series
;:   (cons-stream 1 (integrate-series exp-series)))

;; See the complementary file "streams-SICP.transcript
;; for a few tests of the above procedures



;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; Beyond Here There Be Dragons!
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;;SECTION 3.5.3

(define (sqrt-improve guess x)
  (average guess (/ x guess)))

(define average
  (lambda (x y)
    (/ (+ x y) 2)))

(define (sqrt-stream x)
  (define guesses
    (cons-stream 1.0
                 (stream-map (lambda (guess)
                               (sqrt-improve guess x))
                             guesses)))
  guesses)

;: (display-stream (sqrt-stream 2))


(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))

;: (display-stream pi-stream)


(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)))))

;: (display-stream (euler-transform pi-stream))


(define (make-tableau transform s)
  (cons-stream s
               (make-tableau transform
                             (transform s))))

(define (accelerated-sequence transform s)
  (stream-map stream-car
              (make-tableau transform s)))

;: (display-stream (accelerated-sequence euler-transform
;:                                       pi-stream))


;; EXERCISE 3.63
(define (sqrt-stream x)
  (cons-stream 1.0
               (stream-map (lambda (guess)
                             (sqrt-improve guess x))
                           (sqrt-stream x))))

;; EXERCISE 3.64
(define (sqrt x tolerance)
  (stream-limit (sqrt-stream x) tolerance))


;;; Infinite streams of pairs

;: (stream-filter (lambda (pair)
;:                  (prime? (+ (car pair) (cadr pair))))
;:                int-pairs)

(define (stream-append s1 s2)
  (if (stream-null? s1)
      s2
      (cons-stream (stream-car s1)
                   (stream-append (stream-cdr s1) s2))))


;: (pairs integers integers)


(define (interleave s1 s2)
  (if (stream-null? s1)
      s2
      (cons-stream (stream-car s1)
                   (interleave s2 (stream-cdr s1)))))

(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)))))


;; EXERCISE 3.68

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


;;; Streams as signals

(define (integral integrand initial-value dt)
  (define int
    (cons-stream initial-value
                 (add-streams (scale-stream integrand dt)
                              int)))
  int)


;; EXERCISE 3.74

(define (make-zero-crossings input-stream last-value)
  (cons-stream
   (sign-change-detector (stream-car input-stream) last-value)
   (make-zero-crossings (stream-cdr input-stream)
                        (stream-car input-stream))))

;: (define zero-crossings (make-zero-crossings sense-data 0))



;; EXERCISE 3.75

(define (make-zero-crossings input-stream last-value)
  (let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
    (cons-stream (sign-change-detector avpt last-value)
                 (make-zero-crossings (stream-cdr input-stream)
                                      avpt))))


;;;SECTION 3.5.4

(define (solve f y0 dt)
  (define y (integral dy y0 dt))
  (define dy (stream-map f y))
  y)

(define (integral delayed-integrand initial-value dt)
  (define int
    (cons-stream initial-value
                 (let ((integrand (force delayed-integrand)))
                   (add-streams (scale-stream integrand dt)
                                int))))
  int)

(define (solve f y0 dt)
  (define y (integral (delay dy) y0 dt))
  (define dy (stream-map f y))
  y)


;: (stream-ref (solve (lambda (y) y) 1 0.001) 1000)


;; EXERCISE 3.77

(define (integral integrand initial-value dt)
  (cons-stream initial-value
               (if (stream-null? integrand)
                   the-empty-stream
                   (integral (stream-cdr integrand)
                             (+ (* dt (stream-car integrand))
                                initial-value)
                             dt))))

;;;SECTION 3.5.5

;; same as in section 3.1.2

(define random-init 7)   ;; arbitrary choice

(define rand
  (let ((x random-init))
    (lambda ()
      (set! x (rand-update x))
      x)))


(define random-numbers
  (cons-stream random-init
               (stream-map rand-update random-numbers)))


;: (define cesaro-stream
;:   (map-successive-pairs (lambda (r1 r2) (= (gcd r1 r2) 1))
;:                         random-numbers))

(define (map-successive-pairs f s)
  (cons-stream
   (f (stream-car s) (stream-car (stream-cdr s)))
   (map-successive-pairs f (stream-cdr (stream-cdr s)))))


(define (monte-carlo experiment-stream passed failed)
  (define (next passed failed)
    (cons-stream
     (/ passed (+ passed failed))
     (monte-carlo
      (stream-cdr experiment-stream) passed failed)))
  (if (stream-car experiment-stream)
      (next (+ passed 1) failed)
      (next passed (+ failed 1))))

;: (define pi
;:   (stream-map (lambda (p) (sqrt (/ 6 p)))
;:               (monte-carlo cesaro-stream 0 0)))


;; same as in section 3.1.3
(define (make-simplified-withdraw balance)
  (lambda (amount)
    (set! balance (- balance amount))
    balance))

(define (stream-withdraw balance amount-stream)
  (cons-stream
   balance
   (stream-withdraw (- balance (stream-car amount-stream))
                    (stream-cdr amount-stream))))

Streams Transcript

;; streams-SICP.transcript

;; =============================

;; load stream source code

(load "streams-SICP.ss")

;; =============================

;;;SECTION 3.5

;;;SECTION 3.5.1

;; EXERCISE 3.51

(define x (stream-map show (stream-enumerate-interval 0 10)))
(stream-ref x 5)
(stream-ref x 7)


;; EXERCISE 3.52

(define seq (stream-map accum (stream-enumerate-interval 1 20)))
(define y (stream-filter even? seq))
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
                         seq))

(stream-ref y 7)
(display-stream z)


;;;SECTION 3.5.2

;; sample streams

(define (integers-starting-from n)
  (cons-stream n (integers-starting-from (+ n 1))))

(stream->list (integers-starting-from 13) 10)
; => (13 14 15 16 17 18 19 20 21 22)


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

(stream->list integers 10)
; => (1 2 3 4 5 6 7 8 9 10)


(define (divisible? x y) (= (remainder x y) 0))

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

(stream->list no-sevens 10)
; => (1 2 3 4 5 6 8 9 10 11)

(stream-ref no-sevens 100)
; => 117


(define (fibgen a b)
  (cons-stream a (fibgen b (+ a b))))

(define fibonacci (fibgen 0 1))

;; (stream->list fibonacci 10)
; => (0 1 1 2 3 5 8 13 21 34)


(define (sieve stream)
  (cons-stream
   (stream-car stream)
   (sieve (stream-filter
           (lambda (x)
             (not (divisible? x (stream-car stream))))
           (stream-cdr stream)))))

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

(stream->list sieved-primes 10)
; => (2 3 5 7 11 13 17 19 23 29)

(stream-ref sieved-primes 50)
; => 233

;;==========================================

;;;Defining streams implicitly

;; These definitions come from the file "sample-streams-SF.ss"
;; Springer and Friedman, "Scheme and the Art of Programming," Chapter 15, pages 488-489

(define stream-map
  (lambda (proc strm)
    (cons-stream
     (proc (stream-car strm))
     (stream-map proc (stream-cdr strm)))))

(define stream-apply-to-both
   (lambda (proc)
     (letrec
       ((str-app
         (lambda (s1 s2)
           (cons-stream
            (proc (stream-car s1) (stream-car s2))
            (str-app (stream-cdr s1) (stream-cdr s2))))))
       str-app)))

(define stream-plus 
  (stream-apply-to-both +))

(define stream-times 
  (stream-apply-to-both *))

;; Now let's use these Springer-Friedman procedures 
;; to construct some SICP streams

;;==========================================

;;;Defining streams implicitly

(define ones 
  (cons-stream 1 ones))

(define integers 
  (cons-stream 1 (stream-plus ones integers)))

(define fibs
  (cons-stream 0
               (cons-stream 1
                            (stream-plus (stream-cdr fibs)
                                         fibs))))

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

(define double 
  (cons-stream 1 (scale-stream double 2)))

;; testing

(stream->list ones 10)
; => (1 1 1 1 1 1 1 1 1 1)

(stream->list integers 10)
; => (1 2 3 4 5 6 7 8 9 10)

(stream->list fibs 10)
; => (0 1 1 2 3 5 8 13 21 34)

(stream->list double 10)
; => (1 2 4 8 16 32 64 128 256 512)


; EXERCISE 3.53 (mystery-stream)

(define s 
  (cons-stream 1 (stream-plus s s)))

(stream-ref s 1)

(stream->list s 10)
; => (1 2 4 8 16 32 64 128 256 512)


; EXERCISE 3.54 (mul-streams)

; EXERCISE 3.55 (partial-sums)

; EXERCISE 3.56 (merge)

; EXERCISE 3.58 (expand)


;;;SECTION 3.5.3

; (display-stream (sqrt-stream 2))
; (stream->list (sqrt-stream 2) 10)

Primes

This code is included for use with some of the streams mentioned above.


;; primes.ss

;; primality testing
;; SICP section 1.2.6
;; source code from "ch1.scm"

;;;SECTION 1.2.6

;; prime?

(define (smallest-divisor n)
  (find-divisor n 2))

(define (find-divisor n test-divisor)
  (cond ((> (square test-divisor) n) n)
        ((divides? test-divisor n) test-divisor)
        (else (find-divisor n (+ test-divisor 1)))))

(define square     ;; added by Chris Parrish
  (lambda (x)
    (* x x)))

(define (divides? a b)
  (= (remainder b a) 0))

(define (prime? n)
  (= n (smallest-divisor n)))


;; fast-prime?

(define (expmod base exp m)
  (cond ((= exp 0) 1)
        ((even? exp)
         (remainder (square (expmod base (/ exp 2) m))
                    m))
        (else
         (remainder (* base (expmod base (- exp 1) m))
                    m))))        

(define (fermat-test n)
  (define (try-it a)
    (= (expmod a n n) a))
  (try-it (+ 1 (random (- n 1)))))

(define (fast-prime? n times)
  (cond ((= times 0) true)
        ((fermat-test n) (fast-prime? n (- times 1)))
        (else false)))


;;EXERCISE 1.22
(define (timed-prime-test n)
  (newline)
  (display n)
  (start-prime-test n (runtime)))

(define (start-prime-test n start-time)
  (if (prime? n)
      (report-prime (- (runtime) start-time))))

(define (report-prime elapsed-time)
  (display " *** ")
  (display elapsed-time))

SICP Source Code

Programming Exercises

In class today we will continue our work on the following exercises from chapter 3: 2, 3, 4, 7, 16, 17, 18, 19, 21, 22, 23, 28, 29, 30, 33, 34, 35, 36, 37, 51, 52, 53, 54, 55, 56, 58, 59.