my attempt to do the exercises in sicp.

Sunday, January 2, 2011

sicp exercise 3.70


;Exercise 3.70.  It would be nice to be able to generate streams in which the pairs appear in some useful order, rather than in the order that results from an ad hoc interleaving process. We can use a technique similar to the merge procedure of exercise 3.56, if we define a way to say that one pair of integers is ``less than'' another. One way to do this is to define a ``weighting function'' W(i,j) and stipulate that (i1,j1) is less than (i2,j2) if W(i1,j1) < W(i2,j2). Write a procedure merge-weighted that is like merge, except that merge-weighted takes an additional argument weight, which is a procedure that computes the weight of a pair, and is used to determine the order in which elements should appear in the resulting merged stream.69 Using this, generalize pairs to a procedure weighted-pairs that takes two streams, together with a procedure that computes a weighting function, and generates the stream of pairs, ordered according to weight. Use your procedure to generate

; a. the stream of all pairs of positive integers (i,j) with i < j ordered according to the sum i + j

; b. the stream of all pairs of positive integers (i,j) with i < j, where neither i nor j is divisible by 2, 3, or 5, and the pairs are ordered according to the sum 2 i + 3 j + 5 i j.


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

(display-stream (weighted-pairs integers integers (lambda(s)(+ (car s) (cadr s)))) 20)

(define (div-by x y)(= 0 (remainder x y)))
(define integers-not-div-by-2-3-5
  (stream-filter (lambda(x)
                   (not (or (div-by x 2)
                            (div-by x 3)
                            (div-by x 5))))
                 integers))

;(display-stream integers-not-div-by-2-3-5 20)

(define result (weighted-pairs integers-not-div-by-2-3-5
                               integers-not-div-by-2-3-5
                               (lambda(s)
                                 (let ((i (car s))
                                       (j (cadr s)))
                                   (+ (* 2 i)
                                      (* 3 j)
                                      (* 5 i j))))))

(display-stream result 20)

;Loading "sicp_prob_03.70.scm"...
;(1 1)
;(1 2)
;(2 2)
;(1 3)
;(2 3)
;(1 4)
;(3 3)
;(2 4)
;(1 5)
;(3 4)
;(2 5)
;(1 6)
;(4 4)
;(3 5)
;(2 6)
;(1 7)
;(4 5)
;(3 6)
;(2 7)
;(1 8)
;(5 5)

;(1 1)
;(1 7)
;(1 11)
;(1 13)
;(1 17)
;(1 19)
;(1 23)
;(1 29)
;(1 31)
;(7 7)
;(1 37)
;(1 41)
;(1 43)
;(1 47)
;(1 49)
;(1 53)
;(7 11)
;(1 59)
;(1 61)
;(7 13)
;(1 67)
;... done


No comments: