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

Just a note: it doesn't seem correct to cdddr down the stream here. The fourth variant of 1105 is skipped (see kimdhoe's output).



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

sophia

Simple method modified from 3.71 using stream functions:

  
 (define square-weight 
   (lambda (x) (+ (square (car x)) (square (cadr x))))) 
  
 (define two-squares-three-ways 
   (let ((s (weighted-pairs integers integers square-weight))) 
   (stream-map cadr 
               (stream-filter  
                (lambda (x) (= (square-weight (car x))(cadr x))) 
                (stream-map list s  
                            (stream-cdr (stream-cdr (stream-map square-weight s)))))))) 

poly

I attempt to generalize the procedure of finding the specific amount of numbers. It can be apply to the question 3.71.

  
 (define (square x) (* x x)) 
 (define (square-sum p) (+ (square (car p)) (square (cadr p)))) 
  
 (define square-weighted-stream 
   (weighted-pairs integars integars square-sum)) 
  
 (define (how-many-pairs n) 
   (let ((count 0)) 
     (define (find-number s weight res) 
       ;; the res is a list containing  a number and some pairs with same 
       ;; weight, and it would be empty at the beginning or the time we 
       ;; need to find the next number 
       (if (null? res) 
           (begin (set! count (+ count 1)) 
                  (find-number (stream-cdr s) 
                               weight 
                               (list (weight (stream-car s)) 
                                     (stream-car s)))) 
           ;; find the pairs with same weight 
           (if (= (weight (stream-car s)) (car res)) 
               (begin (set! count (+ count 1)) 
                      (find-number (stream-cdr s) 
                                   weight 
                                   (append res (list (stream-car s))))) 
               ;; the next pair's weight is not the same with previous 
               ;; pairs'. Reset the count and check if the amount of 
               ;; recorded pairs less than given numbers. 
               (let ((records count)) 
                 (begin (set! count 0) 
                        (if (>= records n) 
                            (cons-stream res 
                                         (find-number s weight '())) 
                            (find-number s weight '()))))))) 
     find-number)) 
  
 (define S 
   ((how-many-pairs 3) square-weighted-stream 
                       square-sum 
                       '())) 

the S would like:

 (325 (1 18) (6 17) (10 15)) 
 (425 (5 20) (8 19) (13 16)) 
 (650 (5 25) (11 23) (17 19)) 
 (725 (7 26) (10 25) (14 23)) 
 (845 (2 29) (13 26) (19 22)) 
 (850 (3 29) (11 27) (15 25)) 
 (925 (5 30) (14 27) (21 22)) 
 (1025 (1 32) (8 31) (20 25)) 
 (1105 (4 33) (9 32) (12 31) (23 24)) 
 (1250 (5 35) (17 31) (25 25)) 
 (1300 (2 36) (12 34) (20 30)) 
 (1325 (10 35) (13 34) (22 29)) 
 (1445 (1 38) (17 34) (22 31)) 
 (1450 (9 37) (15 35) (19 33)) 
 (1525 (2 39) (9 38) (25 30)) 
 ...