SICPゼミ第31回
練習問題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)))))
by tube
練習問題3.78
(define (solve-2nd a b y0 dy0 dt) (define y (integral (delay dy) y0 dt)) (define dy (integral (delay ddy) dy0 dt)) (define ddy (add-streams (scale-stream dy a) (scale-stream y b))) y)
下のコードで動かしてみた。cos になればOK
(display-stream-count (solve-2nd 0 -1 1 0 0.001) 10000)
結果
やったー!
by tube
練習問題3.79
(define (solve-2nd f y0 dy0 dt) (define y (integral (delay dy) y0 dt)) (define dy (integral (delay ddy) dy0 dt)) (define ddy (stream-map f y)) y)
結果。sin になればOK
(display-stream-count (solve-2nd (lambda (y) (* y -1)) 0 1 0.001) 10000)
やったーー!
by tube
練習問題3.80
(define (solve-2-1st-ode f g s0 t0 dt) (define s (integral (delay ds) s0 dt)) (define t (integral (delay dtt) t0 dt)) (define ds (stream-map f s t)) (define dtt (stream-map g s t)) (cons s t) ) (define (RLC R L C dt) (define (f v i) (- (/ i C))) (define (g v i) (- (/ v L) (/ (* R i) L))) (define (return vc0 il0) (solve-2-1st-ode f g vc0 il0 dt) ) return)
by dolicas
(display-stream-count ((RLC 1 1 0.2 0.1) 10 0) 500)
(define (rlc-circuit R L C dt) (define (get-initial Vc0 iL0) (define Vc (integral (delay dVc) Vc0 dt)) (define dVc (scale-stream iL (- (/ 1 C)))) (define diL (add-streams (scale-stream Vc (/ 1 L)) (scale-stream iL (- (/ R L))) )) (define iL (integral (delay diL) iL0 dt)) (cons Vc iL)) get-initial)
なぜか動かない。
SICPゼミ第30回
練習問題3.73
(define (RC R C dt) (define (calc i v0) (add-streams (scale-stream i R) (integral (scale-stream i (/ 1 C)) v0 dt))) calc)
民主主義しゅき〜〜(ドナルド・トランプ)
練習問題3.74
(define (sign-change-detector now last) (if (> (* now last) 0) 0 (if (= last 0) (if (>= now 0) 0 -1) (if (< last 0) 1 0)))) (define zero-crossings (stream-map sign-change-detector sense-data (cons-stream 0 sense-data)))
練習問題3.75
(define (make-zero-crossings input-stream last-value last-average) (let ((avpt (/ (+ (stream-car input-stream) last-value) 2))) (cons-stream (sign-change-detector avpt last-average) (make-zero-crossings (stream-cdr input-stream) (stream-car input-stream) avpt))))
by dolicas
練習問題3.76
(define (smooth input-stream) (cons-stream (/ (+ (stream-car input-stream) (stream-car (stream-cdr input-stream))) 2) (smooth (stream-cdr input-stream))))
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
SICPゼミ第28回
練習問題3.63
Reasoner の方法では毎回新しい sqrt-stream (lambda closure の中) を作り出してひとつめの項から計算し直しているので、実質メモ化を行っていないのと同じで、無駄な計算が多くなる。
by tube
SICPゼミ第27回
練習問題3.53
1,2,4,8,16....
練習問題3.54
(define (mul-streams s1 s2) (stream-map * s1 s2)) (define factorials (cons-stream 1 (mul-streams (stream-cdr integers) factorials)))
SICPゼミ第26回
練習問題3.50
(define (stream-map proc . argstreams) (if (null? (car argstreams )) the-empty-stream (stream-cons (apply proc (map stream-car argstreams)) (apply stream-map (cons proc (map stream-cdr argstreams))))))
by dolicas
練習問題3.51
gosh> (define x (stream-map show (stream-enumerate-interval 0 10))) 0x gosh> (stream-ref x 5) 1 2 3 4 55 gosh> (stream-ref x 7) 6 77
練習問題3.52
> (define sum 0) >(define (accum x) (set! sum (+ x sum)) sum) > sum 0 > (define seq (stream-map accum (stream-enumerate-interval 1 20))) > sum 1 > (define y (stream-filter even? seq)) > sum 6 > (define z (stream-filter (lambda (x) (= (remainder x 5) 0)) seq)) > sum 10 > (stream-ref y 7) 136 > sum 136 > (display-stream z) 10 15 45 55 105 120 190 210'done > sum 210
メモ化していないと、毎回accumが呼ばれてsumに足されていってしまうのでへんなことになる。
by tube
SICPゼミ第25回
練習問題3.48
ループができないから。
serialized-exchange の実装例
;今までの serialized-exchange と同じやつ (define (serialized-exchange account1 account2) (let (( serializer1 (account1 'serializer )) (serializer2 (account2 'serializer ))) (( serializer1 (serializer2 exchange )) account1 account2 ))) (define (serialized-exchange-renewal account1 account2) (let ((id1 (get-ID account1)) (id2 (get-ID account2))) (if (> id1 id2) (serialized-exchange account2 accoun1) (serialized-exchange account1 account2))))
by tube