<< Previous exercise (3.71) | Index | Next exercise (3.73) >>
(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 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)) ; ...
(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)))
Constructs a new stream with output in the form of (sum-of-squares, pair1, pair2, pair3)