#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