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