sicp-ex-3.72

Constructs a new stream with output in the form of (sum-of-squares, pair1, pair2, pair3)

 ;; Exercise 3.72 
 (define (sum-of-squares p) 
   (+ (square (car p)) (square (cadr p)))) 
  
 (define ordered-pairs 
   (weighted-pairs integers integers sum-of-squares)) 
  
 (define (equiv-sum-squares-stream s) 
   (let ((next-1 (stream-cdr s)) 
         (next-2 (stream-cdr (stream-cdr s)))) 
     (let ((p1 (stream-car s)) 
           (p2 (stream-car next-1)) 
           (p3 (stream-car next-2))) 
       (let ((x1 (sum-of-squares p1)) 
             (x2 (sum-of-squares p2)) 
             (x3 (sum-of-squares p3))) 
         (if (= x1 x2 x3) 
             (cons-stream 
              (list x1 p1 p2 p3) 
              (equiv-sum-squares-stream (stream-cdr next-2))) 
             (equiv-sum-squares-stream next-1)))))) 
  
 (stream->list (equiv-sum-squares-stream ordered-pairs) 5) 
 ;; ((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))) 

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

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

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

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

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

Again, is this not sufficient?

  
 (define (sum-of-squares x y) 
   (+ (square x) (square y))) 
  
 (define (sum-squares-three-ways? x y z) 
   (= (sum-of-squares (car x) (cadr x)) 
      (sum-of-squares (car y) (cadr y)) 
      (sum-of-squares (car z) (cadr z)))) 
  
 (define sum-squares-three-ways 
   (stream-filter (lambda (x y z) (sum-squares-three-ways? x y z)) 
                  (weighted-pairs integers 
                                  integers 
                                  sum-of-squares)))