ch3

ch3/ex3-64.scm

@@ -0,0 +1,34 @@
+;; Example 3.64
+
+#lang racket
+
+(define (square x) (* x x))
+
+(define (average a b)
+  (/ (+ a b) 2))
+
+(define (sqrt-improve guess x)
+  (average guess (/ x guess)))
+
+(require racket/stream)
+
+(define (sqrt-stream x)
+  (define guesses
+    (stream-cons 1.0
+                 (stream-map (lambda (guess) (sqrt-improve guess x))
+                             guesses)))
+  guesses)
+
+(define (stream-limit stream tol)
+  (let ((s1 (stream-first stream))
+        (s2 (stream-first (stream-rest stream))))
+    (if (< (abs (- s1 s2)) tol)
+        s2
+        (stream-limit (stream-rest (stream-rest stream)) tol))))
+
+(define (my-sqrt x tolerance)
+  (stream-limit (sqrt-stream x) tolerance))
+
+(my-sqrt 2 1)
+(my-sqrt 2 0.5)
+(my-sqrt 2 0.0000001)

ch3/ex3-65.scm

@@ -0,0 +1,69 @@
+;; Example 3.65
+
+#lang racket
+
+(require racket/stream)
+
+;; for partial sums and scaling streams
+
+(define (my-stream-map proc . argstreams)
+  (if (stream-empty? (car argstreams))
+      empty-stream
+      (stream-cons
+       (apply proc (map stream-first argstreams))
+       (apply my-stream-map
+              (cons proc (map stream-rest argstreams))))))
+
+(define (add-streams s1 s2)
+  (my-stream-map + s1 s2))
+
+(define (partial-sums stream)
+  (stream-cons (stream-first stream)
+               (add-streams (partial-sums stream)
+                            (stream-rest stream))))
+
+;; display
+
+(define (display-stream-n stream n)
+  (if (<= n 0)
+      'done
+      (begin
+        (display (stream-first stream))
+        (newline)
+        (display-stream-n (stream-rest stream) (- n 1)))))
+
+;; euler transform
+
+(define (euler-transform s)
+  (let ((s0 (stream-ref s 0))
+        (s1 (stream-ref s 1))
+        (s2 (stream-ref s 2)))
+    (stream-cons (- s2 (/ (* (- s2 s1) (- s2 s1))
+                          (+ s0 (* -2 s1) s2)))
+                 (euler-transform (stream-rest s)))))
+
+(define (make-tableau transform s)
+  (stream-cons s
+               (make-tableau transform
+                             (transform s))))
+
+(define (accelerated-sequence transform s)
+  (stream-map stream-first
+              (make-tableau transform s)))
+
+;; ln
+
+(define (ln-summands n)
+  (stream-cons (/ 1.0 n)
+               (stream-map - (ln-summands (+ n 1)))))
+
+(define ln-stream (partial-sums (ln-summands 1)))
+
+(display "--- ln 2 ---\n\n")
+(display-stream-n ln-stream 10)
+
+(display "\n--- ln 2 euler improved ---\n\n")
+(display-stream-n (euler-transform ln-stream) 10)
+
+(display "\n--- ln 2 euler improved improved ---\n\n")
+(display-stream-n (accelerated-sequence euler-transform ln-stream) 10)

ch3/ex3-67.scm

@@ -0,0 +1,42 @@
+;; Example 3.67
+
+#lang racket
+
+;; display
+
+(define (display-stream-n stream n)
+  (if (<= n 0)
+      'done
+      (begin
+        (display (stream-first stream))
+        (newline)
+        (display-stream-n (stream-rest stream) (- n 1)))))
+
+;; integers
+
+(define (integers-starting-from n)
+  (stream-cons n (integers-starting-from (+ n 1))))
+
+(define integers (integers-starting-from 1))
+
+;;
+
+(define (interleave s1 s2)
+  (if (stream-empty? s1)
+      s2
+      (stream-cons (stream-first s1)
+                   (interleave s2 (stream-rest s1)))))
+
+(define (pairs s t)
+  (stream-cons
+   (list (stream-first s) (stream-first t))
+   (interleave
+    (interleave (stream-map (λ (x) (list (stream-first s) x))
+                            (stream-rest t))
+                (pairs (stream-rest s) (stream-rest t)))
+    (stream-map (λ (x) (list x (stream-first t)))
+                (stream-rest s)))))
+
+(define S (pairs integers integers))
+
+(display-stream-n S 150)

ch3/ex3-68.scm

@@ -0,0 +1,5 @@
+;; Example 3.68
+
+#lang racket
+
+;; infinite loop

ch3/test_iterate_streams.scm

@@ -0,0 +1,89 @@
+#lang racket
+
+(require racket/stream)
+
+;; for partial sums and scaling streams
+
+(define (my-stream-map proc . argstreams)
+  (if (stream-empty? (car argstreams))
+      empty-stream
+      (stream-cons
+       (apply proc (map stream-first argstreams))
+       (apply my-stream-map
+              (cons proc (map stream-rest argstreams))))))
+
+(define (add-streams s1 s2)
+  (my-stream-map + s1 s2))
+
+(define (partial-sums stream)
+  (stream-cons (stream-first stream)
+               (add-streams (partial-sums stream)
+                            (stream-rest stream))))
+
+(define (scale-stream stream factor)
+  (stream-map (lambda (x) (* x factor)) stream))
+
+;; for newton's method
+
+(define (square x) (* x x))
+
+(define (average a b)
+  (/ (+ a b) 2))
+
+(define (sqrt-improve guess x)
+  (average guess (/ x guess)))
+
+;; display
+
+(define (display-stream-n stream n)
+  (if (<= n 0)
+      'done
+      (begin
+        (display (stream-first stream))
+        (newline)
+        (display-stream-n (stream-rest stream) (- n 1)))))
+
+;; test
+
+(define (sqrt-stream x)
+  (define guesses
+    (stream-cons 1.0
+                 (stream-map (lambda (guess) (sqrt-improve guess x))
+                             guesses)))
+  guesses)
+
+(display "--- sqrt 2 ---\n\n")
+(display-stream-n (sqrt-stream 2) 10)
+
+(define (pi-summands n)
+  (stream-cons (/ 1.0 n)
+               (stream-map - (pi-summands (+ n 2)))))
+
+(define pi-stream
+  (scale-stream (partial-sums (pi-summands 1)) 4))
+
+(display "\n--- pi ---\n\n")
+(display-stream-n pi-stream 10)
+
+(define (euler-transform s)
+  (let ((s0 (stream-ref s 0))
+        (s1 (stream-ref s 1))
+        (s2 (stream-ref s 2)))
+    (stream-cons (- s2 (/ (square (- s2 s1))
+                          (+ s0 (* -2 s1) s2)))
+                 (euler-transform (stream-rest s)))))
+
+(display "\n--- pi euler improved ---\n\n")
+(display-stream-n (euler-transform pi-stream) 10)
+
+(define (make-tableau transform s)
+  (stream-cons s
+               (make-tableau transform
+                             (transform s))))
+
+(define (accelerated-sequence transform s)
+  (stream-map stream-first
+              (make-tableau transform s)))
+
+(display "\n--- pi euler improved improved ---\n\n")
+(display-stream-n (accelerated-sequence euler-transform pi-stream) 10)

ch3/test_pairs_streams.scm

@@ -0,0 +1,41 @@
+#lang racket
+
+(require racket/stream)
+
+;; display
+
+(define (display-stream-n stream n)
+  (if (<= n 0)
+      'done
+      (begin
+        (display (stream-first stream))
+        (newline)
+        (display-stream-n (stream-rest stream) (- n 1)))))
+
+;; integers
+
+(define (integers-starting-from n)
+  (stream-cons n (integers-starting-from (+ n 1))))
+
+(define integers (integers-starting-from 1))
+
+;; pairs i <= j
+
+(define (interleave s1 s2)
+  (if (stream-empty? s1)
+      s2
+      (stream-cons (stream-first s1)
+                   (interleave s2 (stream-rest s1)))))
+
+(define (pairs s t)
+  (stream-cons
+   (list (stream-first s) (stream-first t))  ;; S0, T0
+   (interleave
+    (stream-map (lambda (x) (list (stream-first s)  ;; S0
+                                  x)) ;; S0, Ti
+                (stream-rest t))
+    (pairs (stream-rest s) (stream-rest t))))) ;; the same recursively
+
+(define S (pairs integers integers))
+
+(display-stream-n S 150)