Add implementation of exercise 3-67

Author: ramsayleung

README.org

@@ -25,7 +25,7 @@
   习题完成情况:
   - 章节一: 43/46
   - 章节二: 88/97
-  - 章节三: 60/82
+  - 章节三: 61/82
   - 章节四: TODO
   - 章节五: TODO
 * 运行

chapter3/exercise3-67.rkt

@@ -0,0 +1,41 @@
+#lang racket
+(require "stream.rkt")
+(require "infinite-stream.rkt")
+
+;;; 需要混合另一个流是: (S1,T0), (S2, T0), (S3, T0), ..
+
+;; (stream-map (lambda (x) (list (stream-car s) x))
+;;             (stream-cdr t))
+;;; 是生成 (S0, T1), (S0, T2), ..
+
+;; 那么 (S1,T0), (S2, T0), (S3, T0) 就是
+;; (stream-map (lambda (x) (list x (stream-car t)))
+;;             (stream-cdr s))
+
+(define (full-pairs s t)
+  (if (or (stream-null? s) (stream-null? t))
+      the-empty-stream
+      (cons-stream
+       ;; (S0,T0)
+       (list (stream-car s) (stream-car t))
+       (interleave (interleave
+                    ;; (S0, T1), (S0, T2), ..
+                    (stream-map (lambda (x) (list (stream-car s) x))
+                                (stream-cdr t))
+                    ;; (S1,T0), (S2, T0), (S3, T0)
+                    (stream-map (lambda (x) (list x (stream-car t)))
+                                (stream-cdr s)))
+                   ;; (S1,T1), (S1, T2), (S2, T2) ...
+                   (full-pairs (stream-cdr s) (stream-cdr t))
+                   ))))
+
+(module+ test
+  (require rackunit)
+
+  (test-case "Test for full-pairs"
+             (define s1 (list-to-stream '(1 2 3)))
+             (define s2 (list-to-stream '(1 2 3)))
+             (define int-pairs (stream-to-list (full-pairs s1 s2) 9))
+             (check-equal? int-pairs '((1 1) (1 2) (2 2) (2 1) (2 3) (1 3) (3 3) (3 1) (3 2)))
+             )
+  )

chapter3/infinite-stream.rkt

@@ -29,7 +29,23 @@
 (define (scale-stream stream factor)
   (stream-map (lambda (x) (* x factor)) stream))
 
-(provide add-streams scale-stream ones integers fibs)
+(define (interleave s1 s2)
+  (if (stream-null? s1)
+      s2
+      (cons-stream (stream-car s1)
+                   (interleave s2 (stream-cdr s1)))))
+
+(define (pairs s t)
+  (if (or (stream-null? s) (stream-null? t))
+      the-empty-stream
+      (cons-stream
+       (list (stream-car s) (stream-car t))
+       (interleave
+        (stream-map (lambda (x) (list (stream-car s) x))
+                    (stream-cdr t))
+        (pairs (stream-cdr s) (stream-cdr t))))))
+
+(provide add-streams scale-stream ones integers fibs interleave pairs)
 
 (module+ test
   (require rackunit)
@@ -48,4 +64,16 @@
   (test-case "Test for infinite stream"
              (check-equal? (stream-ref fibs 6) 8)
              )
+  (test-case "Test for interleave"
+             (define s1 (list-to-stream '(1 2 3 4 5)))
+             (define s2 (list-to-stream '(6 7 8 9 10)))
+             (check-equal? (stream-to-list (interleave s1 s2) 10) '(1 6 2 7 3 8 4 9 5 10))
+             )
+
+  (test-case "Test for pairs"
+             (define s1 (list-to-stream '(1 2 3)))
+             (define s2 (list-to-stream '(1 2 3)))
+             (define int-pairs (stream-to-list (pairs s1 s2) 4))
+             (check-equal? int-pairs '((1 1) (1 2) (2 2) (1 3)))
+             )
   )