sicp-3-5-3-exploiting-the-stream-paradigm

#lang racket
(require "3-5-streams.rkt")

(define (average a b)
  (/ (+ a b) 2))

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

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

;; Should be: 1.4142135623730951
(display-this-many 10 (sqrt-stream 2) 'vert)
;; 1.0
;; 1.5
;; 1.4166666666666665
;; 1.4142156862745097
;; 1.4142135623746899
;; 1.414213562373095
;; 1.414213562373095
;; 1.414213562373095
;; 1.414213562373095
;; 1.414213562373095
;; 'done

(define (pi-summands n)
  (cons-stream (/ 1.0 n)
               (my-stream-map - (pi-summands (+ n 2)))))

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

;; Should be: 3.141592653589793
(display-this-many 10 pi-stream 'vert)
;; 4.0
;; 2.666666666666667
;; 3.466666666666667
;; 2.8952380952380956
;; 3.3396825396825403
;; 2.9760461760461765
;; 3.2837384837384844
;; 3.017071817071818
;; 3.2523659347188767
;; 3.0418396189294032
;; 'done

(define (euler-transform s)
  (define s0 (my-stream-ref s 0))
  (define s1 (my-stream-ref s 1))
  (define s2 (my-stream-ref s 2))
  (cons-stream (- s2 (/ (sqr (- s2 s1))
                        (+ s0 (* -2 s1) s2)))
               (euler-transform (stream-cdr s))))

;; Should be: 3.141592653589793
(display-this-many 10 (euler-transform pi-stream) 'vert)
;; 3.166666666666667
;; 3.1333333333333337
;; 3.1452380952380956
;; 3.13968253968254
;; 3.1427128427128435
;; 3.1408813408813416
;; 3.142071817071818
;; 3.1412548236077655
;; 3.1418396189294033
;; 3.141406718496503
;; 'done

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

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

;; Should be: 3.141592653589793
(display-this-many 10 (accelerated-sequence euler-transform pi-stream) 'vert)
;; 4.0
;; 3.166666666666667
;; 3.142105263157895
;; 3.141599357319005
;; 3.1415927140337785
;; 3.1415926539752927
;; 3.1415926535911765
;; 3.141592653589778
;; 3.1415926535897953
;; 3.141592653589795
;; 'done

;;;;;;;;;;
;; 3.63 ;;
;;;;;;;;;;

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

;; Recursing on sqrt-stream, instead of using the local variable guesses,
;; repeatedly creates new streams whose elements have not been forced and cached
;; yet.  So you lose the benefits of caching.  If you were using un-memoized
;; streams, there would be no difference.

(time (my-stream-ref (sqrt-stream 2) 100))
;; cpu time: 0 real time: 0 gc time: 0
;; 1.414213562373095
(time (my-stream-ref (slow-sqrt-stream 2) 100))
;; cpu time: 16 real time: 9 gc time: 0
;; 1.414213562373095

(time (my-stream-ref (sqrt-stream 2) 1000))
;; cpu time: 0 real time: 1 gc time: 0
;; 1.414213562373095
(time (my-stream-ref (slow-sqrt-stream 2) 1000))
;; cpu time: 703 real time: 841 gc time: 312
;; 1.414213562373095

;;;;;;;;;;
;; 3.64 ;;
;;;;;;;;;;

(define (stream-limit s tolerance)
  (define (loop s1 s2 str)
    (if (< (abs (- s1 s2)) tolerance)
      s2
      (loop s2 (stream-car str) (stream-cdr str))))
  (loop (stream-car s)
        (stream-car (stream-cdr s))
        (stream-cdr (stream-cdr s))))

;;;;;;;;;;
;; 3.65 ;;
;;;;;;;;;;

(define (ln2-summands n)
  (cons-stream (/ 1.0 n)
               (my-stream-map - (ln2-summands (add1 n)))))

(display-this-many 10 (ln2-summands 1) 'vert)
;; 1.0
;; -0.5
;; 0.3333333333333333
;; -0.25
;; 0.2
;; -0.16666666666666666
;; 0.14285714285714285
;; -0.125
;; 0.1111111111111111
;; -0.1
;; 'done

;; Actual value: ln 2 = 0.6931471805599453

(define ln2-stream1 (partial-sums (ln2-summands 1)))
(time (stream-limit ln2-stream1 0.001))
;; cpu time: 1531 real time: 1536 gc time: 766
;; 0.6936464315588232

(define ln2-stream2 (euler-transform ln2-stream1))
(time (stream-limit ln2-stream2 0.001))
;; cpu time: 0 real time: 0 gc time: 0
;; 0.6928571428571428

(define ln2-stream3 (accelerated-sequence euler-transform ln2-stream1))
(time (stream-limit ln2-stream3 0.001))
;; cpu time: 0 real time: 0 gc time: 0
;; 0.6931488693329254

;; Now let's compare the fast streams.

;; the euler transform
(time (stream-limit ln2-stream2 0.000000001)) ; tolerance is 10 ^ -9
;; cpu time: 609 real time: 618 gc time: 330
;; 0.6931471810586626

;; the accelerated sequence
(time (stream-limit ln2-stream3 0.000000001))
;; cpu time: 0 real time: 0 gc time: 0
;; 0.6931471805604039

;; So the transforms really speed things up.

;;;;;;;;;;
;; 3.66 ;;
;;;;;;;;;;

(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
      (my-stream-map (lambda (x) (list (stream-car s) x))
                  (stream-cdr t))
      (pairs (stream-cdr s) (stream-cdr t)))))

(define prs (pairs integers integers))

(display-this-many 10 prs)
;; (1 1) (1 2) (2 2) (1 3) (2 3) (1 4) (3 3) (1 5) (2 4) (1 6)
;; 'done

;; Let's gather some data on how these elements are arranged in the sequence of
;; pairs.

(define (how-many-precede s elt)
  (define (loop i str)
    (if (equal? (stream-car str) elt)
      i
      (loop (add1 i) (stream-cdr str))))
  (loop 0 s))

;; How many precede (n, n)?
;; Answer: 2 ^ n - 2.
(for ([i (in-range 1 11)])
  (define pr (list i i))
  (printf "~a ~a ~n" pr (how-many-precede prs pr)))
;; (1 1) 0
;; (2 2) 2
;; (3 3) 6
;; (4 4) 14
;; (5 5) 30
;; (6 6) 62
;; (7 7) 126
;; (8 8) 254
;; (9 9) 510
;; (10 10) 1022

;; How many precede (n, n + 1)?
;; Answer: 2 ^ (n - 1) more than precede (n, n).
(for ([i (in-range 1 11)])
  (define pr (list i (add1 i)))
  (printf "~a ~a ~n" pr (how-many-precede prs pr)))
;; (1 2) 1
;; (2 3) 4
;; (3 4) 10
;; (4 5) 22
;; (5 6) 46
;; (6 7) 94
;; (7 8) 190
;; (8 9) 382
;; (9 10) 766
;; (10 11) 1534

;; How many precede (n, n + 2)?
;; Answer: 2 ^ n more than precede (n, n + 1).
(for ([i (in-range 1 11)])
  (define pr (list i (+ i 2)))
  (printf "~a ~a ~n" pr (how-many-precede prs pr)))
;; (1 3) 3
;; (2 4) 8
;; (3 5) 18
;; (4 6) 38
;; (5 7) 78
;; (6 8) 158
;; (7 9) 318
;; (8 10) 638
;; (9 11) 1278
;; (10 12) 2558

;; So the number of elements preceding an element (n, k) will be:

;; 2 ^ n - 2 if k = n
;; 2 ^ n - 2 + 2 ^ (n - 1) if k = n + 1
;; 2 ^ n - 2 + 2 ^ (n - 1) + (k - n - 1) * 2 ^ n if k > n + 1

;; # elements preceding (1, 100) = 2 ^ 1 - 2 + 2 ^ 0 + 98 * 2 ^ 1 = 197
;; # elements preceding (99, 100) = 2 ^ 99 - 2 + 2 ^ 98
    ;; = 950737950171172051122527404030
;; # elements preceding (100, 100) = 2 ^ 100 - 2
    ;; = 1267650600228229401496703205374

(how-many-precede prs '(1 100))
;; 197

;;;;;;;;;;
;; 3.67 ;;
;;;;;;;;;;

;; The idea is to take out the corner element, and then interleave the top row,
;; the first column, and a recursive call to all-pairs.

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

(define all-prs (all-pairs integers integers))

(display-this-many 10 all-prs 'vert)
;; (1 1)
;; (1 2)
;; (2 1)
;; (1 3)
;; (2 2)
;; (1 4)
;; (3 1)
;; (1 5)
;; (2 3)
;; (1 6)
;; 'done

;;;;;;;;;;
;; 3.68 ;;
;;;;;;;;;;

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

;; Evaluating (bad-pairs s t) requires evaluating
;; (bad-pairs (stream-cdr s) (stream-cdr t)), which has the same problem
;; with its own recursive call, and we fall immediately into an infinite loop.
;; This is because of eager evaluation.  Even though interleave uses the
;; stream-car of the first parameter as its own stream-car, eager evaluation
;; requires the computation of the stream-car of both parameters.

;; In general, when defining a stream, you cannot make a recursive call to get the
;; stream-car, only the stream-cdr.

;;;;;;;;;;
;; 3.69 ;;
;;;;;;;;;;

(define (triples s t u)
  (define ps (pairs t u))
  (cons-stream (list (stream-car s)
                     (stream-car t)
                     (stream-car u))
               (interleave (my-stream-map (lambda (p)
                                         (cons (stream-car s) p))
                                       (stream-cdr (pairs t u)))
                           (triples (stream-cdr s)
                                    (stream-cdr t)
                                    (stream-cdr u)))))

(define trpls (triples integers integers integers))

(display-this-many 10 trpls 'vert)
;; (1 1 1)
;; (1 1 2)
;; (2 2 2)
;; (1 2 2)
;; (2 2 3)
;; (1 1 3)
;; (3 3 3)
;; (1 2 3)
;; (2 3 3)
;; (1 1 4)
;; 'done

(define (pythagorean? triple)
  (= (+ (sqr (first triple))
        (sqr (second triple)))
     (sqr (third triple))))

(define pythagorean-triples (my-stream-filter pythagorean? trpls))


;; It will take a very long time to produce more than six of these.
(display-this-many 4 pythagorean-triples 'vert)
;; (3 4 5)
;; (6 8 10)
;; (5 12 13)
;; (9 12 15)
;; 'done

;;;;;;;;;;
;; 3.70 ;;
;;;;;;;;;;

(define (merge-weighted weight ps1 ps2)
  (define p1 (stream-car ps1))
  (define p2 (stream-car ps2))
  (if (> (weight p1) (weight p2))
    (cons-stream p2
                 (merge-weighted weight
                                 ps1
                                 (stream-cdr ps2)))
    (cons-stream p1
                 (merge-weighted weight
                                 (stream-cdr ps1)
                                 ps2))))

(define (weighted-pairs weight s t)
  (cons-stream (list (stream-car s)
                     (stream-car t))
               (merge-weighted weight
                               (my-stream-map (lambda (x) (list (stream-car s) x))
                                              (stream-cdr t))
                               (weighted-pairs weight
                                               (stream-cdr s)
                                               (stream-cdr t)))))

(define (weight1 pr) (+ (first pr) (second pr)))

(define st1 (weighted-pairs weight1 integers integers))

(display-this-many 10 st1 'vert)
;; (1 1)
;; (1 2)
;; (1 3)
;; (2 2)
;; (1 4)
;; (2 3)
;; (1 5)
;; (2 4)
;; (3 3)
;; (1 6)
;; 'done

(define (not-div-2-3-5? a)
  (and (not (zero? (remainder a 2)))
       (not (zero? (remainder a 3)))
       (not (zero? (remainder a 5)))))

(define (weight2 pr) (+ (* 2 (first pr))
                        (* 3 (second pr))
                        (* 5 (first pr) (second pr))))

(define st2 (weighted-pairs
              weight2
              (my-stream-filter not-div-2-3-5? integers)
              (my-stream-filter not-div-2-3-5? integers)))

(display-this-many 10 st2 'vert)
;; (1 1)
;; (1 7)
;; (1 11)
;; (1 13)
;; (1 17)
;; (1 19)
;; (1 23)
;; (1 29)
;; (1 31)
;; (7 7)
;; 'done

;;;;;;;;;;
;; 3.71 ;;
;;;;;;;;;;

(define (generalized-ramanujan f n)
  ;; Generate all positive numbers that can be written as f(i, j) for 0 < i < j
  ;; in n different ways, n > 1, alongwith the corresponding n-tuples.
  (define (tuples s)
    ; Break s into n-tuples.
    (define (loop i lst str)
      (if (> i n)
        (reverse lst)
        (loop (add1 i)
              (cons (stream-car str) lst)
              (stream-cdr str))))
    (cons-stream (loop 1 empty s)
                 (tuples (stream-cdr s))))
  (define (good-tuple? tuple)
    (define val (f (first tuple)))
    (for/and ([i (in-range 1 n)])
             (= (f (list-ref tuple i)) val)))
  (my-stream-map
    (lambda (tuple) (cons (f (first tuple)) tuple))
    (my-stream-filter good-tuple?
                      (tuples (weighted-pairs f
                                              integers
                                              integers)))))

(define (sum-of-cubes pr)
  (+ (expt (first pr) 3)
     (expt (second pr) 3)))

(define ramanujan (generalized-ramanujan sum-of-cubes 2))

(display-this-many 10 ramanujan 'vert)
;; (1729 (1 12) (9 10))
;; (4104 (2 16) (9 15))
;; (13832 (2 24) (18 20))
;; (20683 (10 27) (19 24))
;; (32832 (4 32) (18 30))
;; (39312 (2 34) (15 33))
;; (40033 (9 34) (16 33))
;; (46683 (3 36) (27 30))
;; (64232 (17 39) (26 36))
;; (65728 (12 40) (31 33))
;; 'done

;;;;;;;;;;
;; 3.72 ;;
;;;;;;;;;;

(define (sum-of-squares pr)
  (+ (sqr (first pr))
     (sqr (second pr))))

(define sum-of-two-squares-in-three-ways
  (generalized-ramanujan sum-of-squares 3))

(display-this-many 10 sum-of-two-squares-in-three-ways 'vert)
;; (325 (1 18) (6 17) (10 15))
;; (425 (5 20) (8 19) (13 16))
;; (650 (5 25) (11 23) (17 19))
;; (725 (7 26) (10 25) (14 23))
;; (845 (2 29) (13 26) (19 22))
;; (850 (3 29) (11 27) (15 25))
;; (925 (5 30) (14 27) (21 22))
;; (1025 (1 32) (8 31) (20 25))
;; (1105 (4 33) (9 32) (12 31))
;; (1105 (9 32) (12 31) (23 24))
;; 'done

;;;;;;;;;;
;; 3.73 ;;
;;;;;;;;;;

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

(define (RC R C dt)
  (lambda (i v0)
    (add-streams (scale-stream (integral i v0 dt)
                               (/ 1.0 C))
                 (scale-stream i R))))

(define RC1 (RC 5 1 0.5))

(display-this-many 10 (RC1 ones 2) 'vert)
;; 7.0
;; 7.5
;; 8.0
;; 8.5
;; 9.0
;; 9.5
;; 10.0
;; 10.5
;; 11.0
;; 11.5
;; 'done

;;;;;;;;;;
;; 3.74 ;;
;;;;;;;;;;

(define (sign-change-detector current lastval)
  (cond [(and (negative? lastval) (>= current 0)) 1]
        [(and (>= lastval 0) (negative? current)) -1]
        [else 0]))

(define (get-next current)
  ; get test data by cycling from -2 up to 2 and repeating
  (if (= current 2)
    -2
    (add1 current)))

(define sense-data
  (cons-stream 1 (my-stream-map get-next sense-data)))

(define zero-crossings
  (my-stream-map sign-change-detector
                 sense-data
                 (cons-stream 0 sense-data)))

(display-this-many 10 sense-data)
;; 1 2 -2 -1 0 1 2 -2 -1 0
;; 'done

(display-this-many 10 zero-crossings)
;; 0 0 -1 0 1 0 0 -1 0 1
;; 'done

;;;;;;;;;;
;; 3.75 ;;
;;;;;;;;;;

;; The original version kept averaging in the average value, so avpt was no longer
;; the average of the next two stream elements.

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

(display-this-many 10 (make-zero-crossings sense-data 0 0))
;; 0 0 0 -1 0 1 0 0 -1 0
;; 'done

;;;;;;;;;;
;; 3.76 ;;
;;;;;;;;;;

(define (smooth input-stream)
  (my-stream-map average
                 input-stream
                 (cons-stream 0 input-stream)))

(define (new-make-zero-crossings input-stream)
  (define smoothed-stream (smooth input-stream))
  (my-stream-map sign-change-detector
                 smoothed-stream
                 (cons-stream 0 smoothed-stream)))

(display-this-many 10 (new-make-zero-crossings sense-data))
;; 0 0 0 -1 0 1 0 0 -1 0
;; 'done