Implement till 3.72

ex-3_63-72.scm

@@ -187,6 +187,112 @@
 
 (assert (stream-ref pythagorean-triples 1) '(6 8 10))
 
-(display "\nex-3.70\n")
+(display "\nex-3.70 - pairs-weighted\n")
+
+(define (merge-weighted weight s1 s2)
+  (cond ((stream-null? s1) s2)
+        ((stream-null? s2) s1)
+        (else
+         (let ((s1car (stream-car s1))
+               (s2car (stream-car s2)))
+           (cond ((< (apply weight s1car) (apply weight s2car))
+                  (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2)))
+                 ((> (apply weight s1car) (apply weight s2car))
+                  (cons-stream s2car (merge-weighted weight s1 (stream-cdr s2))))
+                 (else
+                  (cons-stream
+                    s1car
+                    (cons-stream
+                      s2car
+                      (merge-weighted weight (stream-cdr s1)
+                                      (stream-cdr s2))))))))))
+
+(define (pairs-weighted weight s t)
+  (cons-stream
+   (list (stream-car s) (stream-car t))
+   (merge-weighted
+     weight
+     (merge-weighted
+       weight
+       (stream-map (lambda (x) (list (stream-car s) x))
+                   (stream-cdr t))
+       (stream-map (lambda (x) (list x (stream-car t)))
+                   (stream-cdr s)))
+       (pairs-weighted weight (stream-cdr s) (stream-cdr t)))))
+
+(define int-pairs-a
+  (stream-filter
+    (lambda (pair) (apply <= pair))
+    (pairs-weighted + integers integers)))
+
+(assert (take 3 int-pairs-a)
+        '((1 1) (1 2) (1 3)))
+
+(define integers-b
+  (stream-filter
+    (lambda (n) (not (or (= (remainder n 2) 0)
+                         (= (remainder n 3) 0)
+                         (= (remainder n 5) 0))))
+    integers))
+
+(define int-pairs-b
+  (stream-filter
+    (lambda (pair) (apply <= pair))
+    (pairs-weighted
+    (lambda (a b) (+ (* 2 a) (* 3 b) (* 5 a b)))
+    integers-b integers-b)))
+
+(assert (take 3 int-pairs-b)
+        '((1 1) (1 7) (1 11)))
+
+(display "\nex-3.71 - ramanujan-numbers\n")
+
+(define (ramanujan-value a b)
+  (+ (cube a) (cube b)))
+
+(define ramanujan-canditates
+  (stream-map
+    (lambda (pair) (apply ramanujan-value pair))
+    (stream-filter (lambda (pair) (apply <= pair))
+      (pairs-weighted ramanujan-value integers integers))))
+
+(define (ramanujan-numbers canditates)
+  (let ((a (stream-car canditates))
+        (b (stream-car (stream-cdr canditates))))
+    (if (= a b)
+      (cons-stream a (ramanujan-numbers (stream-cdr canditates)))
+      (ramanujan-numbers (stream-cdr canditates)))))
+
+(assert (take 6 (ramanujan-numbers ramanujan-canditates))
+        '(1729 4104 13832 20683 32832 39312))
+
+(display "\nex-3.72 - triple square-sum numbers\n")
+
+(define (square-sum-weigth a b)
+  (+ (square a) (square b)))
+
+(define (consume-equal-square-sums xs)
+  (let ((weight-first (apply square-sum-weigth (stream-car xs)))
+        (weight-second (apply square-sum-weigth (stream-car (stream-cdr xs))))
+        (pair-first (stream-car xs))
+        (pair-second (stream-car (stream-cdr xs))))
+    (if (= weight-first weight-second)
+      (cons (list weight-first pair-first) (consume-equal-square-sums (stream-cdr xs)))
+      (list (list weight-first pair-first)))))
+
+(define (triple-square-sums)
+  (define (find xs)
+    (let ((sequence (consume-equal-square-sums xs)))
+      (if (not (= (length sequence) 3))
+        (find (stream-cdr xs))
+        (cons-stream
+          sequence
+          (find (drop (length sequence) xs))))))
+  (find
+    (stream-filter
+      (lambda (pair) (apply <= pair))
+      (pairs-weighted square-sum-weigth integers integers))))
+
+(assert (car (car (car (take 1 (triple-square-sums)))))
+        325)
 
-; (display "\nex-3.71\n")

util.scm

@@ -74,6 +74,11 @@
     (cons (stream-car xs)
           (take (- n 1) (stream-cdr xs)))))
 
+(define (drop n xs)
+  (if (= n 0)
+    xs
+    (drop (- n 1) (stream-cdr xs))))
+
 (define (find item stream)
   (define (iter n stream)
     (if (equal? (stream-car stream) item)