SICPゼミ第29回

練習問題3.67

(define (pairs s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (interleave
    (interleave
     (stream-map (lambda (x) (list (stream-car t) x))
                 (stream-cdr s))
     (stream-map (lambda (x) (list x (stream-car t)))
                 (stream-cdr s)))
    (pairs (stream-cdr s) (stream-cdr t)))))

実行結果

> (display-stream-count (pairs integers integers) 10)

(1 1)
(1 2)
(2 2)
(2 1)
(2 3)
(1 3)
(3 3)
(3 1)
(3 2)
(1 4)

by tube

練習問題3.68

無限ループする。

関数呼び出しをするとまず引数が評価されるので、Reasonerの(pairs s t)をすると定義内のinterleaveの第2引数である(pairs (stream-cdr s) (stream-cdr t))が評価される。これはpairsの呼び出しの無限ループを引き起こす。

by dolicas

練習問題3.69

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

by dolicas

(define pythagoras
  (stream-filter
   (lambda (triple)
     (= (+ (square (car triple))
           (square (cadr triple)))
        (square (caddr triple))))
   (triples integers integers integers)))

実行結果

> (display-stream-count pythagoras 4)

(3 4 5)
(6 8 10)
(5 12 13)
(9 12 15)

by tube

練習問題3.70

(define (merge-weighted s1 s2 weight)
  (cond ((stream-null? s1) s2)
        ((stream-null? s2) s1)
        (else
          (let ((s1car (stream-car s1))
                (s2car (stream-car s2)))
            (if (weight s1car s2car)
                (cons-stream
                  s1car
                  (merge-weighted (stream-cdr s1) s2 weight))
                (cons-stream
                  s2car
                  (merge-weighted s1 (stream-cdr s2) weight)))))))

(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 (weight1 p1 p2)
  (let ((s1 (+ (car p1) (cadr p1)))
        (s2 (+ (car p2) (cadr p2))))
    (< s1 s2)))

(define (weight2 p1 p2)
  (let ((s1 (+ (* (car p1) 2) (* (cadr p1) 3) (* (car p1) (cadr p1) 5)))
        (s2 (+ (* (car p2) 2) (* (cadr p2) 3) (* (car p2) (cadr p2) 5))))
    (< s1 s2)))

(define a (weighted-pairs integers integers weight1))

(define b
  (stream-filter
    (lambda (x)
      (and (not (= (remainder (car x) 2) 0))
           (not (= (remainder (car x) 3) 0))
           (not (= (remainder (car x) 5) 0))
           (not (= (remainder (cadr x) 2) 0))
           (not (= (remainder (cadr x) 3) 0))
           (not (= (remainder (cadr x) 5) 0))))
    (weighted-pairs integers integers weight2)))

by pine

(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)))))))))
(define (weighted-pairs weight s t)
  (cons-stream
   (list (stream-car s) (stream-car t))
   (merge-weighted
    weight
    (stream-map (lambda (x) (list (stream-car t) x))
                (stream-cdr s))
    (weighted-pairs weight (stream-cdr s) (stream-cdr t)))))

実際に問題解いた
a

> (display-stream-count
   (weighted-pairs
    (lambda (pair)
      (+ (car pair)
         (cadr pair)))
    integers integers) 10)

(1 1)
(1 2)
(1 3)
(2 2)
(1 4)
(2 3)
(1 5)
(2 4)
(3 3)
(1 6)

b

> (define s (stream-filter
             (lambda (x)
               (not (or (= (remainder x 2) 0)
                        (= (remainder x 3) 0)
                        (= (remainder x 5) 0)))) integers))
> (display-stream-count
   (weighted-pairs
    (lambda (pair)
      (+ (* 2(car pair))
         (* 3 (cadr pair))
         (* 5 (car pair) (cadr pair)))) s s) 10)

(1 1)
(1 7)
(1 11)
(1 13)
(1 17)
(1 19)
(1 23)
(1 29)
(1 31)
(7 7)

by tube

練習問題3.71

(define (weight1 p1)
  (+ (cube (car p1)) (cube (cadr p1))))

(define (cube x) (* x x x))

(define (ramanujan)
  (define (pair-cube l) (+ (cube (car l)) (cube (cadr l))))
  (define (ramanujan-iter stream)
    (let ((s1 (pair-cube (stream-car stream)))
      (s2 (pair-cube (stream-car (stream-cdr stream)))))
    (if (= s1 s2)
      (stream-cons s1 (ramanujan-iter (stream-cdr stream)))
      (ramanujan-iter (stream-cdr stream)))))
  (ramanujan-iter (weighted-pairs weight1 integers integers)))

実行結果

> (define x (ramanujan))
> (display-stream-count x 15)
1729
4104
13832
20683
32832
39312
40033
46683
64232
65728
110656
110808
134379
149389
165464

by dolicas

練習問題3.72

(define (pseudo-ramanujan)
  (define (pseudo-iter stream)
    (let ((s1 (pair-square (stream-car stream)))
          (s2 (pair-square (stream-car (stream-cdr stream))))
          (s3 (pair-square (stream-car (stream-cdr (stream-cdr stream))))))
      (if (and (= s1 s2) (= s2 s3))
          (cons-stream s1 (pseudo-iter (stream-cdr stream)))
          (pseudo-iter (stream-cdr stream)))))
  (pseudo-iter (weighted-pairs pair-square integers integers)))

> (display-stream-count (pseudo-ramanujan) 10)

325
425
650
725
845
850
925
1025
1105
1105

by tube