sicp-ex-3.70

Hardest part is thinking of what to name the procedures..

  
 ;; Helper function 
 (define (stream->list stream n) ;; n is number of elements to add to list 
   (if (= n 0) 
       '() 
       (cons (stream-car stream) (stream->list (stream-cdr stream) (- n 1))))) 
  
 ;; Exercise 3.70 
 ;; Part A 
 (define (sum-weight p) 
   (+ (car p) (cadr p))) 
  
 (define (merge-weighted s1 s2 proc) 
   (cond ((stream-null? s1) s2) 
         ((stream-null? s2) s1) 
         (else 
          (let ((s1car (stream-car s1)) 
                (s2car (stream-car s2))) 
            (let ((w1 (proc s1car)) 
                  (w2 (proc s2car))) 
              (if (< w1 w2) 
                  (cons-stream s1car (merge-weighted (stream-cdr s1) s2 proc)) 
                  (cons-stream s2car (merge-weighted s1 (stream-cdr s2) proc)))))))) 
  
 (define (weighted-pairs s1 s2 proc) 
   (cons-stream 
    (list (stream-car s1) (stream-car s2)) 
    (merge-weighted 
     (stream-map (lambda (x) (list (stream-car s1) x)) (stream-cdr s2)) 
     (weighted-pairs (stream-cdr s1) (stream-cdr s2) proc) 
     proc))) 
  
 ;; test 
 (define ordered-pairs (weighted-pairs integers integers sum-weight)) 
 (map sum-weight (stream->list ordered-pairs 50)) 
 ;; (2 3 4 4 5 5 6 6 6 7 7 7 8 8 8 8 9 ... ) 
  
 ;; Part B 
 (define (weight p) 
   (+ (* 2 (car p)) 
      (* 3 (cadr p)) 
      (* 5 (car p) (cadr p)))) 
  
 (define (not-divisible? dividend divisor) 
   (not (= 0 (remainder dividend divisor)))) 
  
 (define (compound-not-divisible? dividend x y z) 
   (and (not-divisible? dividend x) 
        (not-divisible? dividend y) 
        (not-divisible? dividend z))) 
  
 (define filtered-integers 
   (stream-filter (lambda (x) (compound-not-divisible? x 2 3 5)) integers)) 
  
 ;; test 
 (define ordered-conditional-pairs 
   (weighted-pairs filtered-integers filtered-integers weight)) 
  
 (map weight (stream->list ordered-conditional-pairs 50)) 
 ;; (10 58 90 106 138 154 186 234 250 280 298 330 346...)

xdavidliu

For merge-weighted, it is important to include *both* stream heads if there is ever a tie in weight; we don't simply discard duplicates the way we did for merge.

 (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))) 
            (let ((w1 (weight s1car)) 
                  (w2 (weight s2car))) 
              (cond ((< w1 w2) 
                     (cons-stream s1car 
                                  (merge-weighted (stream-cdr s1) s2 weight))) 
                    ((> w1 w2) 
                     (cons-stream s2car 
                                  (merge-weighted s1 (stream-cdr s2) weight))) 
                    (else 
                     (cons-stream 
                      s1car 
                      (cons-stream 
                       s2car ;; must include both in case of ties! 
                                  (merge-weighted 
                                   (stream-cdr s1) 
                                   (stream-cdr s2) 
                                   weight))))))))))

For weighted-pairs, order *within* the pair doesn't matter, so we need to stream-map *twice*, similarly to how we implemented all-pairs in a previous exercise. (I assume we are supposed to keep it general like this rather than assume that i <= j, since the condition "i <= j" is given in the examples part and part b).

 ;; note this fails if the stream-maps don't respect the weight order 
 (define (weighted-pairs s t weight) 
   (cons-stream 
    (list (stream-car s) (stream-car t)) 
    (merge-weighted 
     (merge-weighted 
      (stream-map (lambda (x) (list x (stream-car t))) 
                  (stream-cdr s)) 
      (stream-map (lambda (x) (list (stream-car s) x)) 
                  (stream-cdr t)) 
      weight) 
     (weighted-pairs (stream-cdr s) (stream-cdr t) weight) 
     weight))) 
  
 ;; examples: 
  
 ;; part a of exercise 
  
 (define pascal-triangle 
    (weighted-pairs 
     integers 
     integers 
     (lambda (pair) (apply + pair)))) 
  
 (define (partial-stream->list stream n) 
   (define (rec str i) 
     (if (= i n) 
         () 
         (cons (stream-car str) 
               (rec (stream-cdr str) (1+ i))))) 
   (rec stream 0)) 
 ;; utility function to return list of first n items 
  
 (partial-stream->list pascal-triangle 16) 
 ;; ((1 1) (2 1) (1 2) (3 1) (2 2) (1 3) (4 1) (3 2) (1 4) (2 3) (5 1) (4 2) (1 5) (3 3) (2 4) (6 1)) 
  
 ;; filter to enforce i <= j 
  
 (partial-stream->list 
  (stream-filter (lambda (pair) (apply <= pair)) pascal-triangle) 
  16) 
 ;;((1 1) (1 2) (2 2) (1 3) (1 4) (2 3) (1 5) (3 3) (2 4) (1 6) (2 5) (3 4) (1 7) (2 6) (4 4) (3 5)) 
  
 ;; part b 
  
 (define (weight-235 pair) 
   (let ((i (first pair)) (j (second pair))) 
     (+ (* 2 i) 
        (* 3 j) 
        (* 5 i j)))) 
       
 (define all-integer-pairs-by-weight-235 
   (weighted-pairs integers integers weight-235)) 
  
 (map (lambda (pair) 
        (cons (weight-235 pair) pair)) 
      (partial-stream->list 
       all-integer-pairs-by-weight-235 
       16)) 
 ;; ((10 1 1) (17 2 1) (18 1 2) (24 3 1) (26 1 3) (30 2 2) (31 4 1) (34 1 4) (38 5 1) (42 1 5) (42 3 2) (43 2 3) (45 6 1) (50 1 6) (52 7 1) (54 4 2)) 
  
 ;; now filter in order to satisfy part b condition 
  
 (define (not-divisible-by-235? n) 
   (not (or (even? n) 
            (zero? (remainder n 3)) 
            (zero? (remainder n 5))))) 
  
 (define (part-b-condition? pair) 
   (let ((i (first pair)) (j (second pair))) 
     (and (<= i j) 
          (not-divisible-by-235? i) 
          (not-divisible-by-235? j)))) 
  
 ;; part b result 
  
 (partial-stream->list 
  (stream-filter 
   part-b-condition? 
   all-integer-pairs-by-weight-235) 
  20) 
 ;; ((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)

meteorgan




(define (merge-weighted s1 s2 weight)
        (cond ((stream-null? s1) s2)
                  ((stream-null? s2) s1)
                  (else
                        (let ((cars1 (stream-car s1))
                                  (cars2 (stream-car s2)))
                          (cond ((< (weight cars1) (weight cars2))
                                 (cons-stream cars1 
                                                       (merge-weighted (stream-cdr s1) s2 weight)))
                            ((= (weight cars1) (weight cars2)) 
                                     (cons-stream cars1 
                                                            (merge-weighted (stream-cdr s1) s2 weight)))
                                (else (cons-stream cars2
                                                        (merge-weighted s1 (stream-cdr s2) weight))))))))

(define (weighted-pairs s1 s2 weight)
        (cons-stream (list (stream-car s1) (stream-car s2))
                        (merge-weighted (stream-map (lambda (x) (list (stream-car s1) x))
                                                                           (stream-cdr s2))
                                                 (weighted-pairs (stream-cdr s1) (stream-cdr s2) weight)
                                                                 weight)))
        

(define weight1 (lambda (x) (+ (car x) (cadr x))))
(define pairs1 (weighted-pairs integers integers weight1))
        
(define weight2 (lambda (x) (+ (* 2 (car x)) (* 3 (cadr x)) (* 5 (car x) (cadr x)))))   
(define (divide? x y) (= (remainder y x) 0))
(define stream235
        (stream-filter (lambda (x) (not (or (divide? 2 x) (divide? 3 x) (divide? 5 x))))
                                   integers))
(define pairs2 (weighted-pairs stream235 stream235 weight2))

sam

Another way for part (b) is: use stream from ex3.56 to create weighted-pairs.

beantowel

i think the WEIGHT function takes two arguments rather than one. So i don't understand meteorgan's solution

hoonji

The weight procedure should accept one argument, which is a pair. Note that in this exercise, the merge-weighted procedure operates on a stream of pairs.

mart256

(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)))
                      ((> (weight s1car) (weight s2car)) 
                        (cons-stream 
                                s2car
                                (merge-weighted s1 (stream-cdr s2) weight)))
                          (else
                                (cons-stream
                                        s1car
                    (cons-stream
                       s2car
                                           (merge-weighted (stream-cdr s1)
                                                   (stream-cdr s2) weight)))))))))

Sphinxsky

  
  
  
  
 (define (merge-weighted stream1 stream2 weight) 
     (cond ((stream-null? stream1) stream2) 
         ((stream-null? stream2) stream1) 
         (else 
             (let ((stream1-car (stream-car stream1)) 
                   (stream2-car (stream-car stream2))) 
                 (if (> (weight stream1-car) (weight stream2-car)) 
                     (cons-stream 
                             stream2-car 
                             (merge-weighted stream1 (stream-cdr stream2) weight)) 
                     (cons-stream 
                             stream1-car 
                             (merge-weighted (stream-cdr stream1) stream2 weight))))))) 
  
 (define (weighted-pairs s t weight) 
     (cons-stream 
         (list (stream-car s) (stream-car t)) 
         (merge-weighted 
             (stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t)) 
             (weighted-pairs (stream-cdr s) (stream-cdr t) weight) 
             weight))) 
  
 ; a) 
 (weighted-pairs integers integers (lambda (pair) (apply + pair))) 
  
  
 ; b) 
 (define 2-3-5-number 
     (merge 
         (merge 
             (scale-stream integers 2) 
             (scale-stream integers 3)) 
         (scale-stream integers 5))) 
  
 (weighted-pairs 
     2-3-5-number 
     2-3-5-number 
     (lambda (pair) 
         (let ((i (car pair)) 
               (j (cadr pair))) 
             (+ (* 2 i) (* 3 j) (* 5 i j)))))

Thomas

@Sphinxsky answer for b is incorrect. there i and j are only divisible by by 2,3 or 5, but they should both not be divisible by either of these numbers. Meteorgans solution is correct (didn't bother to check the rest)