問題3-69〜70

問題3-69。pairsの拡張版であるtriplesを定義します。triplesの内部でpairsを使うという発想が浮かばなかったため、全ての組み合わせを洗い出せなかったり、同じ組み合わせが重複して出現してしまったりと、いろいろ試行錯誤してしまいました。Pythagorasの検証を行なわなければ、｢もれ」や｢だぶり｣があることに気づかなかったかもしれません。下記のように、第一要素と第二要素でpairsのようなストリームを作りつつ、第二要素と第三要素の関係性を、さらに内部的なpairsで表現すればよさそうです。

(define (triples s t u)
  (cons-stream
   (list (stream-car s) (stream-car t) (stream-car u))
   (interleave
    (stream-map (lambda (inner-pair)
                  (cons (stream-car s) inner-pair))
                (pairs (stream-cdr t) (stream-cdr u)))
    (triples (stream-cdr s) (stream-cdr t) (stream-cdr u)))))

(define int-triples (triples integers integers integers))

このtriplesのストリームにPythagoras三つ組か否かのフィルターをかけてやります。

(define (pythagoras? x y z)
  (= (+ (* x x) (* y y))
     (* z z)))

(define pythagoras-filter
  (stream-filter (lambda (triple)
                   (pythagoras? (car triple) (cadr triple) (caddr triple)))
                 int-triples))

;=>(3 4 5)
;=>(6 8 10)
;=>(5 12 13)
;=>(9 12 15)
;=>(8 15 17)
;=>...

問題3-70。対の順番が任意の重み付けによって決まるような手続きを定義します。

(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 ((< (weight s1car) (weight s2car))
                  (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2)))
                 ((> (weight s1car) (weight s2car))
                  (cons-stream s2car (merge-weighted weight s1 (stream-cdr s2))))
                 (else
                  (cons-stream s1car (merge-weighted weight (stream-cdr s1) s2))))))))

(define (pairs weight s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (merge-weighted
    weight
    (stream-map (lambda (x) (list (stream-car s) x))
                (stream-cdr t))
    (pairs weight (stream-cdr s) (stream-cdr t)))))

merge-weightedには、重み付けのロジックが書かれているweight手続きを渡します。これを使い、二つのストリームの先頭要素である対の重み付けを比較するわけですが、問題3-56のmergeロジックをそのまま使うと、｢もれ｣が発生してしまいます。weightが(+ i j)だった場合、(1, 4)と(2, 3)は等しいと判断されるわけですが、もとのmergeライクなロジックだと、(2, 3)がmergeされないまま、両方のストリームが先へ進んでしまいます。(2, 3)がもれてしまわないよう、merge-weightedを上記のように修正しました。問題aのストリームは、次のように定義しました。

(define (weight-a pair)
  (+ (car pair) (cadr pair)))

(define int-pairs-weight-a (pairs weight-a integers integers))

;=>(1 1)
;=>(1 2)
;=>(1 3)
;=>(2 2)
;=>(1 4)
;=>(2 3)
;=>(1 5)
;=>(2 4)
;=>(3 3)
;=>(1 6)
;=>...

問題bについては、問題aと同じようにweightを定義しつつ、pairsに渡すストリームをintegersではなく、2,3,5で割り切れないような正の整数のストリームを渡してやればよさそうです。

(define not-2-3-5
  (stream-filter (lambda (x)
                   (and (not (= (remainder x 2) 0))
                        (not (= (remainder x 3) 0))
                        (not (= (remainder x 5) 0))))
                 integers))

;=>1,7,11,13,17,19,23,29,31,37,...

(define int-pairs-weight-b (pairs weight-b not-2-3-5 not-2-3-5))

;=>(1 1)
;=>(1 7)
;=>(1 11)
;=>(1 13)
;=>(1 17)
;=>(1 19)
;=>(1 23)
;=>(1 29)
;=>(1 31)
;=>(7 7)
;=>...

問題3-71と問題3-72は飛ばしました。