Pasted

#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