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

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) 
  
  

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

Another way for part (b) is: use stream from sicp-ex-3.56 to create weighted-pairs.

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

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

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

Isn't all answers incorrect, considering that the first pair is never compared?