Todo
3.57
3.66
3.68
3.70
3.81
3.82
Exercise 3.50
(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 s1 (stream-enumerate-interval 1 10))
;;gosh> (dsp-stream (stream-map * s1 s1 s1))
;;1
;;8
;;27
;;64
;;125
;;216
;;343
;;512
;;729
;;1000
;;done
Exercise 3.51
(define (show x)
(display-line x)
x)
;;gosh> (define x (stream-map show (stream-enumerate-interval 0 10)))
;;
;;0x <-(stream-enumerate-interval 0 10)の最初の項のshowの結果とdefineの値
;;gosh> (stream-ref x 5)
;;
;;1 <-(stream-enumerate-interval 0 10)の2番目の項のshowの結果
;;2 ：
;;3 ：
;;4 ：
;;55 <-(stream-enumerate-interval 0 10)の6番目の項のshowの結果とstream-refの値
;;gosh> (stream-ref x 7)
;; <-2番目から6番目の項はstream-map中のstream-consのmemoによってstream（の状態）が保存されていて、
;; stream-mapが呼び出されないので表示されない
;;6 <-(stream-enumerate-interval 0 10)の7番目の項のshowの結果
;;77 <-(stream-enumerate-interval 0 10)の8番目の項のshowの結果とstream-refの値
Exercise 3.52
(define sum 0)
(define (accum x)
(set! sum (+ x sum))
sum)
(define seq (stream-map accum (stream-enumerate-interval 1 20)))
(define y (stream-filter even? seq))
(define z (stream-filter (lambda (x) (= (remainder x 5) 0))
seq))
(stream-ref y 7)
(display-stream z)
;;;; memoized
;;gosh> (define sum 0)
;;sum
;;gosh> sum
;;0
;;gosh> (define (accum x)
;; (set! sum (+ x sum))
;; sum)
;;accum
;;gosh> sum
;;0
;;gosh> (define seq (stream-map accum (stream-enumerate-interval 1 20)))
;;seq
;;gosh> sum
;;1
;;gosh> (define y (stream-filter even? seq))
;;y
;;gosh> sum
;;6
;;gosh> (define z (stream-filter (lambda (x) (= (remainder x 5) 0))
;; seq))
;;z
;;gosh> sum
;;10
;;gosh> (stream-ref y 7)
;;136
;;gosh> sum
;;136
;;gosh> (display-stream z)
;;
;;
;;10
;;15
;;45
;;55
;;105
;;120
;;190
;;210done
;;gosh> sum
;;210
;;gosh>
;;;; non-memoized
;;gosh> (define sum 0)
;;sum
;;gosh> sum
;;0
;;gosh> (define (accum x)
;; (set! sum (+ x sum))
;; sum)
;;accum
;;gosh> sum
;;0
;;gosh> (define seq (stream-map accum (stream-enumerate-interval 1 20)))
;;seq
;;gosh> sum
;;1
;;gosh> (define y (stream-filter even? seq))
;;y
;;gosh> sum
;;6
;;gosh> (define z (stream-filter (lambda (x) (= (remainder x 5) 0))
;; seq))
;;z
;;gosh> sum
;;15
;;gosh> (stream-ref y 7)
;;162
;;gosh> sum
;;162
;;gosh> (display-stream z)
;;
;;
;;15
;;180
;;230
;;305done
;;gosh> sum
;;362
;;gosh>
;;
;; accumは実行されるたびにsumの値を更新すると共にその値をaccumの値としている。accumの返す値のストリームであるseqは、
;; メモ化されていない時には、メモ化されている時には実行されないaccumの実行をする。
;; このためメモ化されているseqとされていないseqでは値が異なる。更に、メモ化されていないseqでは、以下のように同じ
;; 手続きでも異なった値がかえる。
;;gosh> (stream-ref seq 5)
;;21
;;gosh> (stream-ref seq 5)
;;41
;;gosh> (stream-ref seq 5)
;;61
Exercise 3.53
;; 1,2,4,8,16, ...
(define s (cons-stream 1 (add-streams s s)))
;;gosh> (dsp-stream s)
;;1 2 4 8 16 32 64 128 256 512 done
Exercise 3.54
(define (mul-streams s1 s2)
(stream-map * s1 s2))
(define factorial (cons-stream 1 (mul-streams
factorial
(integers-starting-from 2))))
gosh> (dsp-stream factorial)
1 2 6 24 120 720 5040 40320 362880 3628800 done
Exercise 3.55
(define (partial-sums stream)
(cons-stream (stream-car stream)
(add-streams (stream-cdr stream) (partial-sums stream))))
;;gosh> (dsp-stream (partial-sums integers))
;;1 3 6 10 15 21 28 36 45 55 done
Exercise 3.56
;; 2,3,5 だけが因数の数のstream
(define s (cons-stream 1 (merge (scale-stream s 2)
(merge (scale-stream s 3)
(scale-stream s 5)))))
;;gosh> (dsp-stream s)
;;1 2 3 4 5 6 8 9 10 12 done
Exercise 3.57
Exercise 3.58
;; radix を法とした num/den の小数表示(num＜den＜radix)
(define (expand num den radix)
(cons-stream
(quotient (* num radix) den)
(expand (remainder (* num radix) den) den radix)))
;;gosh> (dsp-stream (expand 1 7 10))
;;1 4 2 8 5 7 1 4 2 8 done
;;gosh> (/ 1.0 7)
;;0.14285714285714285
;;gosh> (dsp-stream (expand 3 8 10))
;;3 7 5 0 0 0 0 0 0 0 done
;;gosh> (/ 3.0 8)
;;0.375
Exercise 3.59
;; a
(define (integrate-series a)
(mul-streams a
(stream-map (lambda (x) (/ 1 x)) integers)))
;;gosh> (dsp-stream (integrate-series ones))
;;1 1/2 1/3 1/4 1/5 1/6 1/7 1/8 1/9 1/10 done
;; b
(define cosine-series
(cons-stream 1 (scale-stream (integrate-series sine-series) -1)))
(define sine-series
(cons-stream 0 (integrate-series cosine-series)))
;;gosh> (dsp-stream cosine-series)
;;1 0 -1/2 0 1/24 0 -1/720 0 1/40320 0 done
;;gosh> (dsp-stream sine-series)
;;0 1 0 -1/6 0 1/120 0 -1/5040 0 1/362880 done
Exercise 3.60
(define (mul-series s1 s2)
(cons-stream (* (stream-car s1) (stream-car s2))
(add-streams
(scale-stream (stream-cdr s2) (stream-car s1))
(mul-series (stream-cdr s1) s2))))
(define sin^2+cos^2 (add-streams
(mul-series sine-series sine-series)
(mul-series cosine-series cosine-series)))
;;gosh> (dsp-stream sin^2+cos^2)
;;1 0 0 0 0 0 0 0 0 0 done
Exercise 3.61
(define (invert-unit-series S)
(cons-stream 1
(scale-stream (mul-series (stream-cdr S)
(invert-unit-series S))
-1)))
(define tan-series
(mul-series sine-series (invert-unit-series cosine-series)))
;;gosh> (dsp-stream tan-series)
;;0 1 0 1/3 0 2/15 0 17/315 0 62/2835 done
Exercise 3.62
(define (div-series N D)
(let ((d (stream-car D)))
(if (= d 0)
(error "DIV-SERIES" D)
(mul-series N
(scale-stream
(invert-unit-series (scale-stream D (/ 1 d)))
d)))))
(define tan-series (div-series sine-series cosine-series))
;;gosh> (dsp-stream tan-series)
;;0 1 0 1/3 0 2/15 0 17/315 0 62/2835 done
Exercise 3.63
;;;memoize版とnon-memoize版の実行回数比較 memo回数/non-memo回数
;;; cons-stream の実行回数：sqrt-streamの実行で1回。streamの5番目の項を得るなら5回/1回と5回
;;; sqrt-improve の実行回数：streamの5番目の項をえるなら5+4+3+2+1回/15回
(define (sqrt-stream x)
(set! c (+ c 1))
(cons-stream 1.0
(stream-map (lambda (guess)
(set! s (+ s 1)) (sqrt-improve guess x))
(sqrt-stream x))))
;;; cons-stream の実行回数：guesses定義時の1回/1回
;;; sqrt-improve の実行回数：streamの5番目の項をえるなら5回/15回
(define (sqrt-stream1 x)
(define guesses
(begin (set! c1 (+ c1 1))
(cons-stream 1.0
(stream-map (lambda (guess)
(set! s1 (+ s1 1)) (sqrt-improve guess x))
guesses))))
guesses)
(define c 0)
(define s 0)
(define c1 0)
(define s1 0)
(define (dsp-cnt)
(display "Louis cons-stream:") (display c)
(display " sqrt-improve:") (display s)
(newline)
(display "guesses cons-stream:") (display c1)
(display " sqrt-improve:") (display s1)
(newline)
(set! c 0) (set! s 0) (set! c1 0) (set! s1 0))
;;memoized-delay is installed
;;gosh> (define ss1 (sqrt-stream 2))
;;ss1
;;gosh> (define ss2 (sqrt-stream1 2))
;;ss2
;;gosh> (stream-ref ss1 5)
;;1.414213562373095
;;gosh> (stream-ref ss2 5)
;;1.414213562373095
;;gosh> (dsp-cnt)
;;Louis cons-stream:6 sqrt-improve:15
;;guesses cons-stream:1 sqrt-improve:5
;;non-memoized-delay is installed
;;gosh> (define ss1 (sqrt-stream 2))
;;ss1
;;gosh> (define ss2 (sqrt-stream1 2))
;;ss2
;;gosh> (stream-ref ss1 5)
;;1.414213562373095
;;gosh> (stream-ref ss2 5)
;;1.414213562373095
;;gosh> (dsp-cnt)
;;Louis cons-stream:6 sqrt-improve:15
;;guesses cons-stream:1 sqrt-improve:15
Exercise 3.64
(define (stream-limit s t)
(let ((s0 (stream-car s))
(s1 (stream-car (stream-cdr s))))
(if (< (abs (- s0 s1)) t)
s1
(stream-limit (stream-cdr s) t))))
(define (sqrt-l x tolerance)
(stream-limit (sqrt-stream x) tolerance))
;;gosh> (dsp-stream (sqrt-stream 2))
;;1.0 1.5 1.4166666666666665 1.4142156862745097 1.4142135623746899 1.414213562373095 1.414213562373095 1.414213562373095 1.414213562373095 1.414213562373095 done
;;gosh> (sqrt-l 2 0.001)
;;1.4142135623746899
Exercise 3.65
(define (ln2-summand n)
(cons-stream (/ 1 n)
(stream-map - (ln2-summand (+ n 1)))))
(define ln2
(partial-sums (ln2-summand 1.0)))
;;; (seq-converge sequense target tolerance)
;;; ->targeet との差が tolerance未満になった sequence の項番(1～)
;;; ->その項の値
(define (seq-converge s tgt tol)
(define (iter s c)
(let ((sn (stream-car s)))
(if (< (abs (- sn tgt)) tol)
(begin (display c)
(newline)
sn)
(iter (stream-cdr s) (+ c 1)))))
(iter s 0))
;;gosh> (seq-converge ln2 0.69315 0.01)
;;49
;;0.6832471605759183
;;gosh> (seq-converge ln2 0.69315 0.001)
;;498
;;0.6941481805579461
;;gosh> (seq-converge (euler-transform ln2) 0.69315 0.01)
;;0
;;0.7
;;gosh> (seq-converge (euler-transform ln2) 0.69315 0.001)
;;3
;;0.6924242424242424
;;gosh> (seq-converge (euler-transform ln2) 0.69315 0.0001)
;;9
;;0.6930657506744464
;;gosh> (seq-converge (euler-transform ln2) 0.69315 0.00001)
;;20
;;0.6931581275621524
;;gosh> (seq-converge (accelerated-sequence euler-transform ln2) 0.69315 0.01)
;;1
;;0.7
;;gosh> (seq-converge (accelerated-sequence euler-transform ln2) 0.69315 0.001)
;;2
;;0.6932773109243697
;;gosh> (seq-converge (accelerated-sequence euler-transform ln2) 0.69315 0.0001)
;;3
;;0.6931488693329254
;;gosh> (seq-converge (accelerated-sequence euler-transform ln2) 0.69315 0.00001)
;;3
;;0.6931488693329254
Exercise 3.66
Exercise 3.67
(define (interleave3 s1 s2 s3)
(cond ((stream-null? s1) (interleave s2 s3))
((stream-null? s2) (interleave s3 s1))
((stream-null? s3) (interleave s1 s2))
(else (cons-stream (stream-car s1)
(interleave3 s2 s3 (stream-cdr s1))))))
(define (pairs s t)
(cons-stream (list (stream-car s) (stream-car t))
(interleave3
(stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t))
(stream-map (lambda (x) (list x (stream-car t))) (stream-cdr s))
(pairs (stream-cdr s) (stream-cdr t)))))
(define (pairs1 s t)
(cons-stream (list (stream-car s) (stream-car t))
(interleave
(interleave
(stream-map (lambda (x) (list (stream-car s) x)) (stream-cdr t))
(stream-map (lambda (x) (list x (stream-car t))) (stream-cdr s)))
(pairs (stream-cdr s) (stream-cdr t)))))
;;gosh> (dsp-stream (pairs integers integers))
;;(1 1) (1 2) (2 1) (2 2) (1 3) (3 1) (2 3) (1 4) (4 1) (3 2) (1 5) (5 1) (3 3) (1 6) (6 1) (2 4) (1 7) (7 1) (4 2) (1 8) done
;;gosh> (dsp-stream (pairs1 integers integers))
;;(1 1) (1 2) (2 2) (2 1) (2 3) (1 3) (3 2) (3 1) (3 3) (1 4) (2 4) (4 1) (4 2) (1 5) (3 4) (5 1) (2 5) (1 6) (5 2) (6 1) done
Exercise 3.68
(define (pairs s t)
(interleave
(stream-map (lambda (x) (list (stream-car s) x)) t)
(pairs (stream-cdr s) (stream-cdr t))))
;; interleave は遅延評価のための delay を生成する訳ではないので
;; pair 定義のための interleave 実行時に pair 実行しようとして
;; ループする
Exercise 3.69
(define (triples s t u)
(cons-stream (cons (stream-car s) (stream-car (pairs t 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)))))
(define (Pytagorean v)
(stream-filter
(lambda (x)
(let ((i (car x))
(j (cadr x))
(k (caddr x)))
(eq? (+ (square i) (square j)) (square k)))) v))
(define P (Pytagorean (triples integers integers integers)))
;;gosh> (dsp-stream P)
;;(3 4 5) (6 8 10) (5 12 13) (9 12 15) done
Exercise 3.70
(define (merge-weighted s1 s2 weight)
(cond ((stream-null? s1) s2)
((stream-null? s2) s1)
(else
(let ((w1 (weight (stream-car s1)))
(w2 (weight (stream-car s2))))
(cond ((>= w1 w2) (cons-stream
(stream-car s2)
(merge-weighted s1 (stream-cdr s2) weight)))
(else (cons-stream
(stream-car s1)
(merge-weighted (stream-cdr s1) s2 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)))
;; a
(define a (weighted-pairs integers integers
(lambda (x) (+ (car x) (cadr x)))))
;; b
(define s (cons-stream 1 (merge (scale-stream s 2)
(merge (scale-stream s 3)
(scale-stream s 5)))))
(define b (weighted-pairs s s
(lambda (x)
(+
(* 2 (car x))
(* 3 (cadr x))
(* 5 (car x) (cadr x))))))
;;gosh> (dsp-stream a)
;;(1 1) (1 2) (2 2) (1 3) (2 3) (1 4) (3 3) (2 4) (1 5) (3 4) (2 5) (1 6) (4 4) (3 5) (2 6) (1 7) (4 5) (3 6) (2 7) (1 8) done
;;gosh> (dsp-stream b)
;;(1 1) (1 2) (1 3) (2 2) (1 4) (1 5) (2 3) (1 6) (2 4) (3 3) (1 8) (2 5) (1 9) (3 4) (2 6) (1 10) (3 5) (1 12) (4 4) (2 8) done
weight関数を選ぶ？
↑ｂは問題読み間違えている。
Exercise 3.71
;; weight for Ramanujan numbers
(define rnw (lambda (x) (+ (cube (car x))
(cube (cadr x)))))
;; stream for Ramanjan numbers
(define srn (weighted-pairs integers integers rnw))
;; weight 同じ？
(define (rn? srn)
(let ((w1 (rnw (stream-car srn)))
(w2 (rnw (stream-car (stream-cdr srn)))))
(= w1 w2)))
;; Ramanujan numbers を生成する pair の stream
(define (rnps)
;; 前とweightが違う
(define (rnps1 stream)
(cond ((rn? stream)
(cons-stream (stream-car stream) (rnps2 (stream-cdr stream))))
(else
(rnps1 (stream-cdr stream)))))
;; 前とweightが同じ
(define (rnps2 stream)
(cond ((rn? stream)
(cons-stream (stream-car stream) (rnps2 (stream-cdr stream))))
(else
(cons-stream (stream-car stream) (rnps1 (stream-cdr stream))))))
(rnps1 srn))
;; Ramanujan numbers の stream
(define (rns)
(define (rnss v stream)
(let ((w (rnw (stream-car stream))))
(cond ((= v w)
(rnss v (stream-cdr stream)))
(else
(cons-stream w (rnss w (stream-cdr stream)))))))
(rnss 0 (rnps)))
;;gosh> (dsp-stream (rns))
;;1729 4104 13832 20683 32832 39312 40033 46683 64232 65728 done
Exercise 3.72
(define weight72 (lambda (x) (+ (square (car x))
(square (cadr x)))))
(define stream72 (weighted-pairs integers integers weight72))
(define (we? stream)
(let ((w1 (weight72 (stream-car stream)))
(w2 (weight72 (stream-car (stream-cdr stream)))))
(= w1 w2)))
(define (pstream)
;; 前とweightが違う
(define (pstr1 stream)
(cond ((and (we? stream) (we? (stream-cdr stream)))
(cons-stream (stream-car stream) (pstr2 (stream-cdr stream))))
(else
(pstr1 (stream-cdr stream)))))
;; 前とweightが同じ
(define (pstr2 stream)
(cond ((we? stream)
(cons-stream (stream-car stream) (pstr2 (stream-cdr stream))))
(else
(cons-stream (stream-car stream) (pstr1 (stream-cdr stream))))))
(pstr1 stream72))
(define (ex3.72 n)
(define (iter v stream i)
(let ((w (weight72 (stream-car stream))))
(cond ((= v w)
(display (stream-car stream)) (iter v (stream-cdr stream) i))
((not (= i n))
(newline) (display w) (display " ") (display (stream-car stream))
(iter w (stream-cdr stream) (+ i 1)))
(else (newline) 'done))))
(iter 0 (pstream) 0))
;;gosh> (ex3.72 10)
;;
;;325 (10 15)(6 17)(1 18)
;;425 (13 16)(8 19)(5 20)
;;650 (17 19)(11 23)(5 25)
;;725 (14 23)(10 25)(7 26)
;;845 (19 22)(13 26)(2 29)
;;850 (15 25)(11 27)(3 29)
;;925 (21 22)(14 27)(5 30)
;;1025 (20 25)(8 31)(1 32)
;;1105 (23 24)(12 31)(9 32)(4 33)
;;1250 (25 25)(17 31)(5 35)
;;done
Exercise 3.73
(define (RC R C dt)
(lambda (is v0)
(add-streams (scale-stream (integral is v0 dt) (/ 1 C))
(scale-stream is R))))
(define (IS E v0 R C dt)
(let ((tau (- (/ 1 (* R C)))))
(stream-map (lambda (x) (/ (* (- E v0) (exp x)) R))
(scale-stream (cons-stream 0 integers) (* tau dt)))))
(define E 5)
(define v0 0)
(define R 5)
(define C 1)
(define dt 0.005)
(define RC1 (RC R C dt))
(define is (IS E v0 R C dt))
(define (p n)
(define (iter s i)
(if (= i n)
'done
(begin (display (stream-car s)) (newline) (iter (stream-cdr s) (+ i 1)))))
(with-output-to-file "ex3_73.gp"
(lambda ()
(display "# RC")(newline)
(iter (RC1 is v0) 0)
(newline) (newline)
(display "# is")(newline)
(iter is 0))))
;;微分方程式の解の IS を RC1 の入力にして、RC1 の値が E と等しい事を確認。
;;dt が粗いと誤差が大きい。
;;（微分方程式の解法は俄か勉強なので違っているかも？）
Exercise 3.74
(define senses '(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
(define sense-data
(stream-map (lambda (x) (list-ref senses x)) (cons-stream 0 integers)))
(define (sign-change-detector c-v l-v)
(cond ((and (>= l-v 0) (< c-v 0)) -1)
((and (< l-v 0) (>= c-v 0)) 1)
(else 0)))
(define (make-zero-crossings input-stream last-value)
(cons-stream
(sign-change-detector (stream-car input-stream) last-value)
(make-zero-crossings (stream-cdr input-stream)
(stream-car input-stream))))
(define zero-crossings_a (make-zero-crossings sense-data 0))
(define zero-crossings
(stream-map sign-change-detector sense-data (cons-stream 0 sense-data)))
;;gosh> (dsp-stream sense-data)
;;1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 done
;;gosh> (dsp-stream zero-crossings_a)
;;0 0 0 0 0 -1 0 0 0 0 1 0 0 done
;;gosh> (dsp-stream zero-crossings)
;;0 0 0 0 0 -1 0 0 0 0 1 0 0 done
Exercise 3.75
(define senses '(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
(define senses-wn '(1 2 100 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
(define (sense-stream senses)
(stream-map (lambda (x) (list-ref senses x)) (cons-stream 0 integers)))
(define (sign-change-detector c-v l-v)
(cond ((and (>= l-v 0) (< c-v 0)) -1)
((and (< l-v 0) (>= c-v 0)) 1)
(else 0)))
;; Louis's version
(define (make-zero-crossings-L input-stream last-value)
(let ((avpt (/ (+ (stream-car input-stream) last-value) 2)))
(cons-stream (sign-change-detector avpt last-value)
(make-zero-crossings-L (stream-cdr input-stream)
avpt))))
(define (zero-crossings-L senses)
(make-zero-crossings-L (sense-stream senses) 0))
;; [[Alyssa]]'s Plan
(define (make-zero-crossings input-stream last-avalue last-svalue)
(let ((avpt (/ (+ (stream-car input-stream) last-svalue) 2)))
(cons-stream (sign-change-detector avpt last-avalue)
(make-zero-crossings (stream-cdr input-stream)
avpt
(stream-car input-stream)))))
(define (zero-crossings senses)
(make-zero-crossings (sense-stream senses) 0 0))
;; Louis は平均を求めるための前回の値として、前回の平均の値を使用している。
;; このため、大きなノイズは後々まで影響する。
;; Alyssa のプランは、前回の測定値と今回の測定値の平均をとる。
;;gosh> (dsp-stream (sense-stream senses-wn))
;;1 2 100 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 done
;;gosh> (dsp-stream (zero-crossings-L senses-wn))
;;0 0 0 0 0 0 0 -1 0 0 0 1 0 done
;;gosh> (dsp-stream (zero-crossings senses-wn))
;;0 0 0 0 0 0 -1 0 0 0 0 1 0 done
;; ただ、どちららも平均をとるので、変化の検出が遅くなってしまっている。
;;また、ノイズの出方によってはこんなになってしまう
(define senses-wn2 '(1 2 -100 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
;;gosh> (dsp-stream (zero-crossings-L senses-wn2))
;;0 0 -1 0 0 0 0 0 0 0 0 1 0 done
;;gosh> (dsp-stream (zero-crossings senses-wn2))
;;0 0 -1 0 1 0 -1 0 0 0 0 1 0 done
Exercise 3.76
(define senses '(1 2 1.5 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
(define senses-wn '(1 2 100 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
(define senses-wn2 '(1 2 -100 1 0.5 -0.1 -2 -3 -2 -0.5 0.2 3 4 5))
(define (sense-stream senses)
(stream-map (lambda (x) (list-ref senses x)) (cons-stream 0 integers)))
(define (sign-change-detector c-v l-v)
(cond ((and (>= l-v 0) (< c-v 0)) -1)
((and (< l-v 0) (>= c-v 0)) 1)
(else 0)))
(define (smooth stream)
(cons-stream (/ (+ (stream-car stream) (stream-car (stream-cdr stream))) 2)
(smooth (stream-cdr stream))))
(define (zero-crossing-m senses)
(stream-map sign-change-detector
(smooth (sense-stream senses))
(cons-stream 0 (smooth (sense-stream senses)))))
;;gosh> (dsp-stream (zero-crossing-m senses))
;;0 0 0 0 0 -1 0 0 0 0 1 0 done
;;gosh> (dsp-stream (zero-crossing-m senses-wn))
;;0 0 0 0 0 -1 0 0 0 0 1 0 done
;;gosh> (dsp-stream (zero-crossing-m senses-wn2))
;;0 -1 0 1 0 -1 0 0 0 0 1 0 done
Exercise 3.77
(define (integral delayed-integrand initial-value dt)
(cons-stream initial-value
(let ((integrand (force delayed-integrand)))
(if (stream-null? integrand)
the-empty-stream
(integral (delay (stream-cdr integrand))
(+ (* dt (stream-car integrand))
initial-value)
dt)))))
;;以下で dy/dt の前に y を定義すると
;;gosh> (solve (lambda (y) y) 1 0.001)
;;*** ERROR: pair required, but got #<undef>
;;と y が評価されない？
;;なぜ、この逆にした定義順で y がunbound variableにならない？
;;gauche は内部定義は定義とは逆の順で評価している？
;;http://practical-scheme.net/wiliki/wiliki.cgi?Scheme%3a%e5%86%85%e9%83%a8define%e3%81%ae%e8%a9%95%e4%be%a1%e9%a0%86
;;ともかみ合っていない？？
(define (solve f y0 dt)
(define dy/dt (stream-map f y))
(define y (integral (delay dy/dt) y0 dt))
;(define dy/dt (stream-map f y))
y)
(define e (solve (lambda (y) y) 1 0.001))
;;gosh> (stream-ref e 1000)
;;2.716923932235896
Exercise 3.78
(define (solve-2nd a b dt y0 dy0)
(define ddy/dtt (add-streams (scale-stream dy/dt a)
(scale-stream y b)))
(define dy/dt (integral (delay ddy/dtt) dy0 dt))
(define y (integral (delay dy/dt) y0 dt))
y)
Exercise 3.79
(define (solve-3rd f dt y0 dy0)
(define ddy/dtt (stream-map f dy/dt))
(define dy/dt (integral (delay ddy/dtt) dy0 dt))
(define y (integral (delay dy/dt) y0 dt))
y)
Exercise 3.80
(define (RLC R L C dt)
(lambda (vC0 iL0)
(define diL/dt (add-streams (scale-stream vC (/ 1 L))
(scale-stream iL (- (/ R L)))))
(define dvC/dt (scale-stream iL (- (/ 1 C))))
(define vC (integral (delay dvC/dt) vC0 dt))
(define iL (integral (delay diL/dt) iL0 dt))
(cons vC iL)))
(define vCiL ((RLC 1 1 0.2 0.01) 10 0))
最終更新：2008年10月13日 13:15
