SICP/ex-3_63-xx.scm

(load "util.scm")

(define (pi-summands n)
  (cons-stream (/ 1. n)
               (stream-map - (pi-summands (+ n 2)))))

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

(define (euler-transform s)
  (let ((s0 (stream-ref s 0))           ; Sn-1
        (s1 (stream-ref s 1))           ; Sn
        (s2 (stream-ref s 2)))          ; Sn+1
    (cons-stream (- s2 (/ (square (- s2 s1))
                          (+ s0 (* -2 s1) s2)))
                 (euler-transform (stream-cdr s)))))

(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 (take 5 pi-stream))
; (newline)
; (display (take 5 (euler-transform pi-stream)))
; (newline)
; (display (take 5 (accelerated-sequence euler-transform pi-stream)))
; (newline)

(display "\nex-3.63 - sqrt-stream\n")

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

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

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

(display (stream-ref (sqrt-stream 2) 1000))
(newline)

; The first implementation of sqrt-stream computes each value of the stream
; only once. Louis' suggestion computes all previous values because of the
; recursive calls to sqrt-stream. If memoization was not used the two solutions
; would behave in the same way.

(display "\nex-3.64 - stream-limit\n")

(define (stream-limit stream tolerance)
  (if (< (abs (- (stream-car stream)
                 (stream-car (stream-cdr stream))))
         tolerance)
    (stream-car (stream-cdr stream))
    (stream-limit (stream-cdr stream) tolerance)))

(define (sqrt-tol x tolerance)
  (stream-limit (sqrt-stream x) tolerance))

(assert (< (abs (- 1.4142135623730951 (sqrt-tol 2 0.01)))
           0.01) #t)

(assert (< (abs (- 4.795831523312719 (sqrt-tol 23 0.001)))
           0.001) #t)

(display "\nex-3.65 - ln2\n")

(define (ln2-summands n)
  (cons-stream (/ 1. n)
               (stream-map - (ln2-summands (+ n 1)))))

(define ln2-stream
  (partial-sums (ln2-summands 1)))

; slow
(define (ln2-tol tolerance)
  (stream-limit ln2-stream tolerance))

; fast
(define (ln2-tol tolerance)
  (stream-limit (accelerated-sequence euler-transform ln2-stream) tolerance))

(assert (ln2-tol 0.00000000001)
        0.6931471805599445)

; The series converges slowly. Only with acceleration we get a good result in
; reasonable time.

(display "\nex-3.66\n")

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

(define int-pairs (pairs integers integers))

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

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

(assert (find (list 2 5) prime-pairs) 6)
(assert (find (list 3 3) int-pairs) 6)
(assert (find (list 1 100) int-pairs) 197)
;(assert (find (list 99 100) int-pairs) 1000)
;(assert (find (list 100 100) int-pairs) 10)

; I haven't been able to figure out the relationship by myself.
; The explanations on Schemewiki are good, though:
; http://community.schemewiki.org/?sicp-ex-3.66

(display "\nex-3.67 - all-pairs\n")

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

(define int-pairs (all-pairs integers integers))

(assert (stream-ref int-pairs 10) '(3 4))

(display "\nex-3.68 - non-lazy pairs\n")
(display "[answered]\n")

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

; MIT-Scheme uses applicative-order evluation. Hence, pairs gets evaluated
; recursively. Since there is no delay this implementation results in an
; endless loop.

(display "\nex-3.69 - triples\n")

(define (triples a b c)
  (cons-stream
    (list (stream-car a) (stream-car b) (stream-car c))
    (interleave
      (stream-map (lambda (pairs) (cons (stream-car a) pairs))
                  (pairs b (stream-cdr c)))
      (triples (stream-cdr a) (stream-cdr b) (stream-cdr c)))))

(define (pythagorean? a b c)
    (= (+ (* a a) (* b b)) (* c c)))

(define pythagorean-triples
  (stream-filter (lambda (ts) (apply pythagorean? ts))
                 (triples integers integers integers)))

(assert (stream-ref pythagorean-triples 1) '(6 8 10))

(display "\nex-3.70\n")

; (display "\nex-3.71\n")