my attempt to do the exercises in sicp.

Sunday, January 2, 2011

sicp exercise 3.72



; Exercise 3.72.  In a similar way to exercise 3.71 generate a stream of all numbers that can be written as the sum of two squares in three different ways (showing how they can be so written).


(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 (integers-from-n n)
  (cons-stream n (integers-from-n (+ 1 n))))

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

(define (merge-weighted s1 s2 weight)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
         (let ((s1car (stream-car s1))
               (s2car (stream-car s2)))
           (cond ((< (weight s1car) (weight s2car))
                  (cons-stream s1car (merge-weighted (stream-cdr s1) s2 weight)))
                 (else
                  (cons-stream s2car (merge-weighted s1 (stream-cdr s2) weight))))))))

(define (f1 s t)
  (cons-stream (list (stream-car s) (stream-car t))
               (f1 s (stream-cdr t))))
(define (f0 s t weight)
  (cons-stream (list (stream-car s) (stream-car t))
               (merge-weighted (f1 s (stream-cdr t))
                               (f0 (stream-cdr s) (stream-cdr t) weight)
                               weight)))
(define (weighted-pairs s t weight) (f0 s t weight))

(define (square x)(* x x))
(define square-weighted-pairs (weighted-pairs integers integers (lambda(s)(+ (square (car s)) (square (cadr s))))))
;(display-stream square-weighted-pairs 50)

(define (check-eq-weight s weight)
  (let ((a (stream-car s))
        (b (stream-car (stream-cdr s)))
        (c (stream-car (stream-cdr (stream-cdr s)))))
    (if (and (= (weight a) (weight b))
             (= (weight b) (weight c)))
        (cons-stream (list (weight a) a b c)
                     (check-eq-weight (stream-cdr s) weight))
        (check-eq-weight (stream-cdr s) weight))))

(define result (check-eq-weight square-weighted-pairs (lambda(s)
                                                        (+ (square (car s))
                                                           (square (cadr s))))))

(display-stream result 4)

;Loading "sicp_prob_03.72.scm"...
;(325 (10 15) (6 17) (1 18))
;(425 (13 16) (8 19) (5 20))
;(650 (17 19) (11 23) (5 25))
;(725 (14 23) (10 25) (7 26))
;(845 (19 22) (13 26) (2 29))
;... done


No comments: