my attempt to do the exercises in sicp.

Saturday, January 1, 2011

sicp exercise 3.69



; Exercise 3.69.  Write a procedure triples that takes three infinite streams, S, T, and U, and produces the stream of triples (Si,Tj,Uk) such that i < j < k. Use triples to generate the stream of all Pythagorean triples of positive integers, i.e., the triples (i,j,k) such that i < j and i^2 + j^2 = k^2.

(define (display-line str)
  (display str)
  (newline))

(define (display-stream str num)
  (define (internal index)
    (if (> index num) 'printed
        (begin
          (display-line (stream-ref str index))
          (internal (+ 1 index)))))
  (newline)(internal 0))

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

(define (integers-from-n n)
  (cons-stream n (integers-from-n (+ 1 n))))

(define integers (integers-from-n 1))


;; another way to construct all pairs <i,j>, same as produces in exercise 67
;; the same idea is being used to produce triples below
(define (incr1 s t)
  (cons-stream (list (stream-car s) (stream-car t)) (incr1 (stream-cdr s) t)))
(define (incr2 s t)
  (cons-stream (list (stream-car s) (stream-car t)) (incr2 s (stream-cdr t))))
(define (pair2 s t)
  (cons-stream (list (stream-car s)
                     (stream-car t))
               (interleave (incr2 s (stream-cdr t))
                           (interleave (incr1 (stream-cdr s) t)
                                       (pair2 (stream-cdr s) (stream-cdr t))))))
;;(newline)
;;(display-stream (pair2 integers integers) 20)


(define (f1 s t u)
  (cons-stream (list (stream-car s)
                     (stream-car t)
                     (stream-car u))
               (f1 s t (stream-cdr u))))

(define (f2 s t u)
  (cons-stream (list (stream-car s)
                     (stream-car t)
                     (stream-car u))
               (interleave (f1 s t (stream-cdr u))
                           (f2 s (stream-cdr t) (stream-cdr u)))))

(define (f0 s t u)
  (cons-stream (list (stream-car s)
                     (stream-car t)
                     (stream-car u))
               (interleave (f1 s t (stream-cdr u))
                           (interleave (f2 s (stream-cdr t) (stream-cdr u))
                                       (f0 (stream-cdr s)
                                           (stream-cdr t)
                                           (stream-cdr u))))))

(define triples (f0 integers integers integers))

;(newline)
;(display-stream triples 20)

(define (stream-filter pred stream)
  (cond ((stream-null? stream) the-empty-stream)
        ((pred (stream-car stream))
         (cons-stream (stream-car stream)
                      (stream-filter pred
                                     (stream-cdr stream))))
        (else (stream-filter pred (stream-cdr stream)))))

(define (pythagorean? p)
  (= (+ (square (car p))
        (square (cadr p)))
     (square (caddr p))))

(display-stream (stream-filter pythagorean? triples) 2)

;; Output:
;Loading "sicp_prob_03.69.scm"...
;(3 4 5)
;(6 8 10)
;(5 12 13)
;... done



No comments: