sicp-ex-3.70



<< Previous exercise (3.69) | Index | Next exercise (3.71) >>


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

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