sicp-ex-3.72



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


meteorgan

  
  
  
  
 (define (square x) (* x x)) 
 (define (sum-square x) (+ (square (car x)) (square (cadr x)))) 
 (define (squaresn s) 
         (define (stream-cadr s) (stream-car (stream-cdr s))) 
         (define (stream-caddr s) (stream-cadr (stream-cdr s))) 
         (let ((scar (stream-car s)) 
                   (scadr (stream-cadr s)) 
                   (scaddr (stream-caddr s))) 
                 (if (= (sum-square scar) (sum-square scadr) (sum-square scaddr)) 
                         (cons-stream (list (sum-square scar) scar scadr scaddr) 
                                                  (squaresn (stream-cdr (stream-cdr (stream-cdr s))))) 
                         (squaresn (stream-cdr s))))) 
 (define square-numbers  
         (squaresn (weighted-pairs integers integers sum-square))) 

kimdhoe

  
  
  
 #lang racket 
  
 (define (ex.3.72) 
   (let* ([pairs (weighted-pairs integers 
                                 integers 
                                 (lambda (p) 
                                   (+ (sqr (car  p)) 
                                      (sqr (cadr p)))))] 
          [triples (stream-map 
                     (lambda (p) 
                       (cons (+ (sqr (car p)) (sqr (cadr p))) 
                             p)) 
                     pairs)]) 
     (define (take-same s n) 
       (if (= (car (stream-first s)) n) 
           (cons (cdr (stream-first s)) 
                 (take-same (stream-rest s) n)) 
           '())) 
     (define (remove-same s n) 
       (if (= (car (stream-first s)) n) 
           (remove-same (stream-rest s) n) 
           s)) 
     (define (result s) 
       (let ([s0 (stream-ref s 0)] 
             [s1 (stream-ref s 1)] 
             [s2 (stream-ref s 2)]) 
         (if (= (car s0) (car s1) (car s2)) 
             (stream-cons (cons (car s0) (take-same s (car s0))) 
                          (result (remove-same s (car s0)))) 
             (result (stream-rest s))))) 
     (result triples))) 
  
 (stream->list-n 20 (ex.3.72)) 
 ;; '(( 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)       ) 
 ;;   ( 850  (15 25) (11 27) ( 3 29)       ) 
 ;;   ( 925  (21 22) (14 27) ( 5 30)       ) 
 ;;   (1025  (20 25) ( 8 31) ( 1 32)       ) 
 ;;   (1105  (23 24) (12 31) ( 9 32) (4 33)) 
 ;;   (1250  (25 25) (17 31) ( 5 35)       ) 
 ;;   (1300  (20 30) (12 34) ( 2 36)       ) 
 ;;   (1325  (22 29) (13 34) (10 35)       ) 
 ;;   (1445  (22 31) (17 34) ( 1 38)       ) 
 ;;   (1450  (19 33) (15 35) ( 9 37)       ) 
 ;;   (1525  (25 30) ( 9 38) ( 2 39)       ) 
 ;;   (1625  (28 29) (20 35) (16 37) (5 40)) 
 ;;   (1690  (27 31) (13 39) ( 3 41)       ) 
 ;;   (1700  (26 32) (16 38) (10 40)       ) 
 ;;   (1825  (23 36) (15 40) (12 41)       ) 
 ;;   (1850  (25 35) (13 41) ( 1 43)       )) 
  

karthikk

Nice kimdhoe!

We can of course reuse code from exercise 3.71. Suppose we had a function there that checked to see if the weight of two consecutive pairs in the stream of pairs was equal and consed them into a result, say eq-conseq-pairs

E.g. an implementation could have been:

 (define (eq-conseq-pairs weighted-series weight wcar) 
   (let ((scar (stream-car weighted-series)) 
         (scadr (stream-car (stream-cdr weighted-series)))) 
     (let ((wcadr (weight scadr))) 
       (cond ((= wcar wcadr) 
              (cons-stream (cons wcar (list scar scadr)) 
                           (eq-conseq-pairs (stream-cdr weighted-series) weight wcadr))) 
             (else (eq-conseq-pairs (stream-cdr weighted-series) weight wcadr)))))) 
  

Then we can simply define a function eq3-conseq-pairs that reuses the old one in the following way:

  
 (define (eq3-conseq-pairs weighted-series weight) 
   (let ((eq2 (eq-conseq-pairs weighted-series weight (weight (stream-car weighted-series))))) 
     (eq-conseq-pairs eq2 car (car (stream-car eq2))))) 
  

Of course the way it prints output isnt too pretty but that can be hacked easily...

Output:

 (325 (325 (1 18) (6 17)) (325 (6 17) (10 15))) 
 (425 (425 (5 20) (8 19)) (425 (8 19) (13 16))) 
 (650 (650 (5 25) (11 23)) (650 (11 23) (17 19))) 
 (725 (725 (7 26) (10 25)) (725 (10 25) (14 23))) 
 (845 (845 (2 29) (13 26)) (845 (13 26) (19 22))) 
 (850 (850 (3 29) (11 27)) (850 (11 27) (15 25))) 
 (925 (925 (5 30) (14 27)) (925 (14 27) (21 22))) 
 (1025 (1025 (1 32) (8 31)) (1025 (8 31) (20 25))) 
 ...