SICP 読み (133) 3.5.2 無限ストリーム
問題 3.56
問題の意味がよく分からん。こーゆー意味なんだろうか。
(define S (cons-stream 1 (merge (scale-stream S 2) (merge (scale-stream S 3) (scale-stream S 5)))))
上記を閃いた時点では、どんな出力かがイメージできておらず、以下のような試験をでっち上げ、叱られております。
("merge"
("S"
(assert-equal 1 (stream-ref S 0))
(assert-equal 2 (stream-ref S 1))
(assert-equal 3 (stream-ref S 2))
(assert-equal 4 (stream-ref S 3))
(assert-equal 5 (stream-ref S 4))
(assert-equal 6 (stream-ref S 5))
(assert-equal 8 (stream-ref S 6))
(assert-equal 9 (stream-ref S 7))
(assert-equal 10 (stream-ref S 8))
(assert-equal 12 (stream-ref S 9))
(assert-equal 14 (stream-ref S 10))
(assert-equal 15 (stream-ref S 11))
(assert-equal 16 (stream-ref S 12))
(assert-equal 18 (stream-ref S 13))
(assert-equal 20 (stream-ref S 14))
(assert-equal 21 (stream-ref S 15))
)
)上記では 14 と 21 がダウト。ここでようやく理解。2、3、5 以外の因子は持たないのか。(って問題に書いてるし)
何と言えば良いのか分かりませんがこれは凄い。以下に一式を
- 本体 (lib/3.5.1.scm)
(define-syntax cons-stream
(syntax-rules ()
((_ a b) (cons a (delay b)))))
(define-syntax delay
(syntax-rules ()
((_ p) (memo-proc (lambda () p)))))
(define (force delayed-object) (delayed-object))
(define (memo-proc p)
(let ((already-run? #f) (result #f))
(lambda ()
(if (not already-run?)
(begin (set! result (p))
(set! already-run? #t)
result)
result))))
(define (stream-car s) (car s))
(define (stream-cdr s) (force (cdr s)))
(define (map1 p items)
(if (null? items)
'()
(cons (p (car items))
(map1 p (cdr items)))))
(define (map2 p . l)
(if (null? (car l))
'()
(cons (apply p (map1 car l))
(apply map2 (cons p (map1 cdr l))))))
(define (stream-map proc . argstreams)
(if (stream-null? (car argstreams))
the-empty-stream
(cons-stream
(apply proc (map stream-car argstreams))
(apply stream-map
(cons proc (map stream-cdr argstreams))))))
(define the-empty-stream '())
(define (stream-null? s) (null? s))
(define (stream-ref s n)
(if (= n 0)
(stream-car s)
(stream-ref (stream-cdr s) (- n 1))))
(define (stream-map-example proc s)
;(define (stream-map proc s)
(if (stream-null? s)
the-empty-stream
(cons-stream (proc (stream-car s))
(stream-map-example proc (stream-cdr s)))))
; (stream-map proc (stream-cdr s)))))
(define (stream-for-each proc s)
(if (stream-null? s)
'done
(begin (proc (stream-car s))
(stream-for-each proc (stream-cdr s)))))
(define (display-stream s)
(stream-for-each display-line s))
(define (display-line x)
(display x)
(newline))
(define (stream-enumerate-interval low high)
(if (> low high)
the-empty-stream
(cons-stream
low
(stream-enumerate-interval (+ low 1) high))))
(define (stream-filter pred stream)
(cond ((stream-null? stream) the-empty-stream)
((pred (stream-car stream))
(cons-stream (stream-car stream)
(stream-filter pred
(stream-cdr stream))))
(else
(stream-filter pred (stream-cdr stream)))))
(define ones (cons-stream 1 ones))
(define (add-streams s1 s2)
(stream-map + s1 s2))
(define integers (cons-stream 1 (add-streams ones integers)))
(define (mul-streams s1 s2)
(stream-map * s1 s2))
;(define factorials (cons-stream 1 (mul-streams integers factorials)))
(define factorials (cons-stream 1 (mul-streams (stream-cdr integers) factorials)))
(define (scale-stream stream factor)
(stream-map (lambda (x) (* x factor)) stream))
(define (merge s1 s2)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((s1car (stream-car s1))
(s2car (stream-car s2)))
(cond ((< s1car s2car)
(cons-stream s1car (merge (stream-cdr s1) s2)))
((> s1car s2car)
(cons-stream s2car (merge s1 (stream-cdr s2))))
(else
(cons-stream s1car
(merge (stream-cdr s1)
(stream-cdr s2)))))))))
(define S (cons-stream 1 (merge (scale-stream S 2)
(merge (scale-stream S 3)
(scale-stream S 5)))))
- 試験 (test/test-3.5.1.scm)
#!/usr/bin/env gosh
(use test.unit)
(require "3.5.1")
(define-test-suite "3.5.1"
("scale-stream"
("double"
(letrec ((double (cons-stream 1 (scale-stream double 2))))
(assert-equal 1 (stream-ref double 0))
(assert-equal 2 (stream-ref double 1))
(assert-equal 4 (stream-ref double 2))
(assert-equal 8 (stream-ref double 3))
(assert-equal 16 (stream-ref double 4))
(assert-equal 32 (stream-ref double 5))
(assert-equal 64 (stream-ref double 6))
(assert-equal 128 (stream-ref double 7))
(assert-equal 256 (stream-ref double 8))
(assert-equal 512 (stream-ref double 9))
(assert-equal 1024 (stream-ref double 10))
)
)
("tri"
(letrec ((tri (cons-stream 1 (scale-stream tri 3))))
(assert-equal 1 (stream-ref tri 0))
(assert-equal 3 (stream-ref tri 1))
(assert-equal 9 (stream-ref tri 2))
(assert-equal 27 (stream-ref tri 3))
(assert-equal 81 (stream-ref tri 4))
(assert-equal 243 (stream-ref tri 5))
(assert-equal 729 (stream-ref tri 6))
)
)
("fif"
(letrec ((fif (cons-stream 1 (scale-stream fif 5))))
(assert-equal 1 (stream-ref fif 0))
(assert-equal 5 (stream-ref fif 1))
(assert-equal 25 (stream-ref fif 2))
(assert-equal 125 (stream-ref fif 3))
(assert-equal 625 (stream-ref fif 4))
)
)
)
("merge"
("S"
(assert-equal 1 (stream-ref S 0))
(assert-equal 2 (stream-ref S 1))
(assert-equal 3 (stream-ref S 2))
(assert-equal 4 (stream-ref S 3))
(assert-equal 5 (stream-ref S 4))
(assert-equal 6 (stream-ref S 5))
(assert-equal 8 (stream-ref S 6))
(assert-equal 9 (stream-ref S 7))
(assert-equal 10 (stream-ref S 8))
(assert-equal 12 (stream-ref S 9))
; (assert-equal 14 (stream-ref S 10))
(assert-equal 15 (stream-ref S 10))
; (assert-equal 15 (stream-ref S 11))
; (assert-equal 16 (stream-ref S 12))
(assert-equal 16 (stream-ref S 11))
; (assert-equal 18 (stream-ref S 13))
(assert-equal 18 (stream-ref S 12))
; (assert-equal 20 (stream-ref S 14))
(assert-equal 20 (stream-ref S 13))
; (assert-equal 21 (stream-ref S 15))
)
)
)scale-stream に stream を渡してるから 6 とか 15 とかが出てくるんですか。ヤッツケてしまってますが、まだオチてはいない自分も居ます。(を
