sicp-ex-3.72



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


dzy

 (define (weight s)  
         (let ((i (car s)) 
                                 (j (cadr s))) 
                          (+ (expt i 2) (expt j 2))))      
 (define (merge-weighted s t weight) 
         (cond ((stream-null? s) t) 
                                 ((stream-null? t) s) 
                                 (else 
                                         (let ((s0 (stream-car s)) 
                                                                 (t0 (stream-car t))) 
                                                          (cond ((< (weight s0) (weight t0)) 
                                                                                         (cons-stream s0  
                                                                                                                                          (merge-weighted (stream-cdr s) t weight))) 
                                                                                  (else  
                                                                                         (cons-stream t0 
                                                                                                                                          (merge-weighted (stream-cdr t) s weight)))))))) 
 (define (pairs-weighted 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)) 
     (pairs-weighted (stream-cdr s) (stream-cdr t) weight) 
                 weight))) 
 (define (get-number s) 
         (let ((last-number (stream-ref s 0)) 
                                 (s0 (stream-ref s 1)) 
                                 (s1 (stream-ref s 2)) 
                                 (s2 (stream-ref s 3)) 
                                 (s3 (stream-cdr (stream-cdr s)))) 
                          (cond ((or (= last-number (weight s0))  
                                                                         (not (= (weight s0) (weight s1) (weight s2)))) 
                                                         (get-number (cons-stream last-number s3))) 
                                                  (else (cons-stream (list (weight s0) s0 s1 s2) 
                                                                                                                                 (get-number (cons-stream (weight s0) s3))))))) 
                                                                                                                                   
 (define s (pairs-weighted integers integers weight)) 
 (define q (get-number (cons-stream 0 s))) 
 (display-stream q 10) 
 ;(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)) 
 ;(1250 (5 35) (17 31) (25 25)) 

zerocooldown

  
  
  
 (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))) 
  
 (define (collect-consecutive-pairs-n s n evaluator-n) 
   (let ((next-n (take-n s n))) 
     (if (evaluator-n next-n) 
         (cons-stream next-n 
                      (collect-consecutive-pairs-n (stream-cdr s) 
                                                   n 
                                                   evaluator-n)) 
         (collect-consecutive-pairs-n (stream-cdr s) 
                                      n 
                                      evaluator-n)))) 
  
 (define (square-sum p) 
   (let ((i (car p)) 
         (j (cadr p))) 
     (+ (* i i) 
        (* j j)))) 
  
 (define 3-way-square-sum 
   (stream-map (lambda (t) 
                 (list (square-sum (car t)) t)) 
               (collect-consecutive-pairs-n (weighted-pairs integers 
                                                            integers 
                                                            square-sum) 
                                            3 
                                            (lambda (t) 
                                              (= (square-sum (car t)) 
                                                 (square-sum (cadr t)) 
                                                 (square-sum (caddr t))))))) 
  

rmn

  
  
  
 (define (square-weight x y) 
   (+ (* x x) (* y y))) 
  
 (define squared-ints-pairs 
   (weighted-pairs integers integers (lambda (x) (apply square-weight x)))) 
  
 (define (take-stream stream n) 
   (if (= n 0) 
       '() 
       (cons (stream-car stream) 
             (take-stream (stream-cdr stream) (- n 1))))) 
  
 (define (two-squares-three-ways-helper s weight) 
   (let ((vals (take-stream s 3))) 
     (if (apply = (map (lambda (x) (apply weight x)) vals)) 
         (cons-stream (apply weight (car vals)) 
                      (two-squares-three-ways-helper (stream-cdr s) weight)) 
         (two-squares-three-ways-helper (stream-cdr s) weight)))) 
  
 (define two-squares-three-ways 
   (two-squares-three-ways-helper squared-ints-pairs square-weight)) 
  
 (take-stream two-squares-three-ways 5) 
 ; (325 425 650 725 845) 

seok

A generic procedure for problems like 3.71 and 3.72.

  
 ;; s : A stream of lists sorted in ascending order w.r.t aggr-fn. 
 ;; aggr-fn : A function used to sort lists of s. Receives one list as a parameter. 
 ;;           Return value doesn't have to be an interger as long as it has an ordering. 
 ;; n : Minimum number of consecutive elts. 
 (define (consecutive-elts-from-stream s aggr-fn n) 
     (define (skip-same-elts s val) 
         (if (equal? (aggr-fn val) (aggr-fn (stream-car s))) 
             (skip-same-elts (stream-cdr s) val) 
             s))  
  
     (define (build-same-elts-list from to)  
         (let ((first (stream-car from)) 
               (next (stream-cdr from))) 
         (cond ((null? to)  
                (build-same-elts-list next (list first))) 
               ((equal? (aggr-fn first) (aggr-fn (car to))) 
                (build-same-elts-list next (cons first to))) 
               (else to)))) 
  
     (if (equal? (aggr-fn (stream-car s))  
                 (aggr-fn (stream-ref s (- n 1)))) 
         (cons-stream (cons (aggr-fn (stream-car s))  
                            (build-same-elts-list s ())) 
                      (consecutive-elts-from-stream (skip-same-elts s (stream-car s)) aggr-fn n))  
         (consecutive-elts-from-stream (skip-same-elts s (stream-car s)) aggr-fn n))) 
  
 ;; 3.72 
 (define (sum-squares li) (apply + (map square li))) 
 (define sum-square-ordered-pairs 
     (weighted-pairs sum-squares integers integers)) 
  
 (define pseudo-ramanujan 
     (consecutive-elts-from-stream sum-square-ordered-pairs sum-squares 3)) 
  
 (display-stream pseudo-ramanujan) 
 ; (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)) 
 ; ... 
  
 ;; 3.71 
 (define (cube x) (* x x x)) 
 (define (sum-cubes li) (apply + (map cube li))) 
  
 (define sum-cube-ordered-pairs 
     (weighted-pairs sum-cubes integers integers)) 
  
 (define ramanujan 
     (consecutive-elts-from-stream sum-cube-ordered-pairs sum-cubes 2)) 
  
 (display-stream ramanujan) 
 ; (1729 (1 12) (9 10)) 
 ; (4104 (2 16) (9 15)) 
 ; (13832 (2 24) (18 20)) 
 ; (20683 (10 27) (19 24)) 
 ; (32832 (4 32) (18 30)) 
 ; (39312 (2 34) (15 33)) 
 ; (40033 (9 34) (16 33)) 
 ; (46683 (3 36) (27 30)) 
 ; (64232 (17 39) (26 36)) 
 ; (65728 (12 40) (31 33)) 
 ; ... 

Sphinxsky

  
  
  
  
  
 (define (triple-ways-square-sum-numbers) 
     (define (square-sum pair) (apply + (map square pair))) 
     (define square-pairs (weighted-pairs integers integers square-sum)) 
     (define (rec . streams) 
         (let ((car-streams (map stream-car streams))) 
             (if (apply = (map square-sum car-streams)) 
                 (cons-stream 
                     car-streams 
                     (apply rec (map stream-cdr streams))) 
                 (apply rec (map stream-cdr streams))))) 
     (stream-map 
         (lambda (pairs) 
             (cons (square-sum (car pairs)) pairs)) 
         (rec 
             square-pairs 
             (stream-cdr square-pairs) 
             (stream-cdr (stream-cdr square-pairs)))))