問題3.70-3.72

少し間があきましたがストリーム続きです。

3.70

(define (merge-weighted sp1 sp2 weight)
  (cond ((stream-null? sp1) sp2)
        ((stream-null? sp2) sp1)
        (else
         (let ((sp1car (stream-car sp1)) (sp2car (stream-car sp2)))
           (cond ((< (weight sp1car) (weight sp2car))
                  (cons-stream sp1car (merge-weighted (stream-cdr sp1) sp2 weight)))
                 ((> (weight sp1car) (weight sp2car))
                  (cons-stream sp2car (merge-weighted sp1 (stream-cdr sp2) weight)))
                 (else
                  (cons-stream sp1car
                               (cons-stream sp2car
                                            (merge-weighted (stream-cdr sp1) (stream-cdr sp2) weight)))))))))
(define (weighted-pairs s1 s2 weight)
  (cons-stream (list (stream-car s1) (stream-car s2))
               (merge-weighted (stream-map (lambda (x) (list (stream-car s1) x)) (stream-cdr s2))
                               (weighted-pairs (stream-cdr s1) (stream-cdr s2) weight)
                               weight)))

elseの場合(重みが同じ場合)をちょっと変えないとだめでした。

a.
(define 3-70-a (weighted-pairs integers integers (lambda (x) (+ (car x) (cadr x)))))

> (disp-stream-n 3-70-a 20)
((1 1) (1 2) (1 3) (2 2) (1 4) (2 3) (1 5) (2 4) (3 3) (1 6) (2 5) (3 4) (1 7) (2 6) (3 5) (4 4) (1 8) (2 7) (3 6) (4 5))
b.
(define 3-70-b
  (weighted-pairs (stream-filter (lambda (x) (and (not (= (modulo x 2) 0))
                                                  (not (= (modulo x 3) 0))
                                                  (not (= (modulo x 5) 0))))
                                 integers)
                  (stream-filter (lambda (x) (and (not (= (modulo x 2) 0))
                                                  (not (= (modulo x 3) 0))
                                                  (not (= (modulo x 5) 0))))
                                 integers)
                  (lambda (sp) (+ (* 2 (car sp)) (* 3 (cadr sp)) (* 5 (car sp) (cadr sp))))))

> (disp-stream-n 3-70-b 20)
((1 1) (1 7) (1 11) (1 13) (1 17) (1 19) (1 23) (1 29) (1 31) (7 7) (1 37) (1 41) (1 43) (1 47) (1 49) (1 53) (7 11) (1 59) (1 61) (7 13))

bはもうちょっとスマートに書けるかもしれません。

3.71

Ramanujan numberの生成。注のRamanujanの逸話がかっこいい。

(define (Ramanujan-num n)
  (define (cube i) (* i i i))
  (define (r-weight p) (+ (cube (car p)) (cube (cadr p))))
  (define ij-stream (weighted-pairs integers integers r-weight))
  (define (rec s n prev-rnum)
    (let ((car-weight (r-weight (stream-car s)))
          (cadr-weight (r-weight (stream-car (stream-cdr s)))))
    (cond ((= n 0) '())
          ((= car-weight prev-rnum)
           (rec (stream-cdr s) n prev-rnum))
          ((= car-weight cadr-weight)
           (cons car-weight (rec (stream-cdr (stream-cdr s)) (- n 1) car-weight)))
          (else
           (rec (stream-cdr s) n prev-rnum)))))
  (rec ij-stream n 0))

> (Ramanujan-num 5)
(1729 4104 13832 20683 32832)
> (Ramanujan-num 10)
(1729 4104 13832 20683 32832 39312 40033 46683 64232 65728)

ストリームでスマートに書けると楽しい。

3.72

(define (sqr-sum n)
  (define (s-weight p) (+ (sqr (car p)) (sqr (cadr p))))
  (define ij-stream (weighted-pairs integers integers s-weight))
  (define (rec s n prev-snum)
    (let ((car-w (s-weight (stream-car s)))
          (cadr-w (s-weight (stream-car (stream-cdr s))))
          (caddr-w (s-weight (stream-car (stream-cdr (stream-cdr s))))))
      (cond ((= n 0) '())
            ((= car-w prev-snum) (rec (stream-cdr s) n prev-snum))
            ((= car-w cadr-w caddr-w) (cons car-w (rec (stream-cdr s) (- n 1) car-w)))
            (else (rec (stream-cdr s) n prev-snum)))))
  (rec ij-stream n 0))

> (sqr-sum 10)
(325 425 650 725 845 850 925 1025 1105 1250)
> (sqr-sum 20)
(325 425 650 725 845 850 925 1025 1105 1250 1300 1325 1445 1450 1525 1625 1690 1700 1825 1850)

三通りの異なる方法で二つの平方数の和となるものを得るために、まずi \leq jとなる全ての非負整数の組(i, j)を重みを平方の和i^2+j^2として重みの小さい順に整列させたストリームij-streamを生成。
三通りの異なる方法とは、(i1, j1) ≠ (i2, j2) ≠ (i3, j3)なる組について、全て同じ数nになることを言うので、ij-streamから3つ以上同じ重みを持つ組があったらその重みが欲しい平方数の和になる。

ところで、生成した数字全部5の倍数ですね。3つ以上の異なるpairで作られた平方数の和は5の倍数になるのかな、と思って100個試してみたらちゃんとそうでないものが出てきました。残念。

短いですが今日はここまで。