ようやく最新の分。4/8〜9の分。
Exercise 3.24
make-tableに引数same-key?を追加した。
内部定義としてequal?の代わりにsame-key?を用いるassocを追加した。
(define (make-table same-key?)
(let ((local-table (list '*table*)))
(define (lookup key-1 key-2)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(cdr record)
#f))
#f)))
(define (insert! key-1 key-2 value)
(let ((subtable (assoc key-1 (cdr local-table))))
(if subtable
(let ((record (assoc key-2 (cdr subtable))))
(if record
(set-cdr! record value)
(set-cdr! subtable
(cons (cons key-2 value)
(cdr subtable)))))
(set-cdr! local-table
(cons (list key-1
(cons key-2 value))
(cdr local-table)))))
'ok)
(define (assoc key records)
(cond ((null? records) #f)
((same-key? key (caar records)) (car records))
(else (assoc key (cdr records)))))
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation - TABLE" m))))
dispatch))
(define (nearly-equal? a b)
(if (and (number? a) (number? b))
(< (abs (- a b)) 0.001)
(equal? a b)))
(define operation-table (make-table nearly-equal?))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
(put '*table* 3.1415 'pi)
(print (get '*table* 3.1415)) ;-> pi
(print (get '*table* 3.141)) ;-> pi
(print (get '*table* 3.14)) ;-> #f
Exercise 3.25
;lookupとinsert!のみ変更。
(define (make-table)
(let ((local-table (list '*table*)))
(define (lookup . keys)
(define (lookup-iter keys table)
(let ((subtable (assoc (car keys) (cdr table))))
(if subtable
(if (null? (cdr keys))
(cadr subtable)
(lookup-iter (cdr keys) subtable))
#f)))
(lookup-iter keys local-table))
(define (insert! . keys)
(define (insert-iter keys table)
(let ((subtable (assoc (car keys) (cdr table))))
(if subtable
(if (null? (cdr keys))
(set-cdr! subtable (car keys))
(insert-iter (cdr keys) subtable))
(if (null? (cddr keys))
(set-cdr! table
(cons (cons (car keys) (cdr keys)) (cdr table)))
(begin
(set-cdr! table
(cons (cons (car keys) '()) (cdr table)))
(insert-iter (cdr keys) (cadr table)))))))
(insert-iter keys local-table)
'ok)
(define (dispatch m)
(cond ((eq? m 'lookup-proc) lookup)
((eq? m 'insert-proc!) insert!)
(else (error "Unknown operation - TABLE" m))))
dispatch))
(define operation-table (make-table))
(define get (operation-table 'lookup-proc))
(define put (operation-table 'insert-proc!))
;テスト
;１次元の表
(put 'record1 'a)
(put 'record2 'b)
(print (get 'record1))
(print (get 'record2))
(newline)
;２次元の表
(put 'letters 'a 97)
(put 'letters 'b 39)
(put 'math '+ 43)
(put 'math '- 45)
(put 'math '* 42)
(print (get 'letters 'a))
(print (get 'letters 'b))
(print (get 'math '+))
(print (get 'math '-))
(print (get 'math '*))
(newline)
;３次元の表
(put 'table1 'table2 'record1 'hoge)
(print (get 'table1 'table2 'record1))
Exercise 3.26
分からーーん。ハイレベルそうなので飛ばす。
Exercise 3.27
（メモ化。一度計算した関数の値を保存しておく。）
環境図省略。
(memo-fib n)がΘ(n)で計算できる理由？
nが一つ増加するのに伴って必要となる計算量は、nのサイズと関係なく
加算１回とテーブルからのデータの取り出し２回だけで一定である。
したがってステップ数ｎに比例した計算量で計算することが出来る。
(define memo-fib (memoize fib))で同じようにΘ(n)で計算出来るか？
出来ない。ステップｎで計算するためには再帰的に呼び出される関数も
メモ化されていなければならないが、
(define memo-fib (memoize fib))
としてもmemo-fibの内部で再帰的に呼ばれるのは(memoize fib)ではなくただのfibになるのでメモ化は働かない。
Exercise 3.28
;andをorに置換しただけだけど。抽象手続きが多すぎてどこまでやったらいいか謎。
(define (or-gate a1 a2 output)
(define (or-action-procedure)
(let ((new-value
(logical-or (get-signal a1) (get-signal a2))))
(after-delay or-gate-delay
(lambda ()
(set-signal! output new-value)))))
(add-action! a1 or-action-procedure)
(add-action! a2 or-action-procedure)
'ok)
Exercise 3.29
;これも抽象手続きを使ってるので動作確認できてない。
;and-gate-delay+inverter-delay*2位。
(define (or-gate a1 a2 output)
(let ((not-a1 (make-new-wire))
(not-a2 (make-new-wire))
(not-output (make-new-wire)))
(inverter a1 not-a1)
(inverter a2 not-a2)
(and-gate not-a1 not-a2 not-output)
(inverter not-output output)))
Exercise 3.30
(define (ripple-carry-adder Ak Bk Sk c)
(define (iter ak bk sk c-out)
(if (and (null? ak) (null? bk) (null? sk))
'ok
(let ((c-in (make-new-wire)))
(full-adder (car ak) (car bk) c-out (car sk) c-in)
(iter (cdr ak) (cdr bk) (cdr sk) c-in))))
(let ((c-in (make-new-wire)))
(full-adder (car Ak) (car Bk) c-in (car Sk) c)
(iter (cdr Ak) (cdr Bk) (cdr Sk) c-in)))
Exercise 3.31
配線が繋がった瞬間にもその電気信号でイベントが起こる可能性があるから。
例えば
(define a (make-new-wire))
(define b (make-new-wire))
(define c (make-new-wire))
(and-gate a b c)
とした時に繋いだ時点でcの値が変化しないと困る。
Exercise 3.32
分かりません。
Exercise 3.33
(define (averager a b c)
(let ((d (make-connector))
(e (make-connector)))
(adder a b d)
(multiplier d e c)
(constant 0.5 e)
'ok))
Exercise 3.34
multiplierは2引数の内二つが定まるともう一つの値を決める。
従って以下のようにbにのみ値を与えてもaの値が定まることは無い。
(define a (make-connector))
(define b (make-connector))
(squarer a b)
(probe 'a a)
(probe 'b b)
(set-value! b '4 'user)
Probe: b = 4
(本当はここにProbe: a = 2と表示されて欲しい。)
Exercise 3.35
(define (squarer a b)
(define (process-new-value)
(if (has-value? b)
(if (< (get-value b) 0)
(error "square less than 0 - SQUARER" (get-value b))
(set-value! a (sqrt (get-value b)) me))
(set-value! b (* (get-value a) (get-value a)) me)))
(define (process-forget-value)
(forget-value! a me)
(forget-value! b me))
(define (me request)
(cond ((eq? request 'I-have-a-value)
(process-new-value))
((eq? request 'I-lost-my-value)
(process-forget-value))
(else
(error "Unknown request -- SQUARER" request))))
(connect a me)
(connect b me)
me)
Exercise 3.36
環境図。飛ばす。
Exercise 3.37
(add a b c)
(sub d e f)
(mult c f g)
g
を
(mult (add a b) (sub d e))
に書き換える問題。以前Cでベクトル演算書いたとき似たような事をした気がする。
Cでは合成オブジェクトを返せないので計算結果の配列を指すポインタを返したり。
しかもCにはクロージャなんてものが無いので(局所変数が保存される保証が無く、
関数内の局所変数のポインタを返すと警告が出る)自前でmallocして確保したり。
答え。
(define (c+ x y)
(let ((z (make-connector)))
(adder x y z)
z))
(define (c- x y)
(let ((z (make-connector)))
(adder z y x)
z))
(define (c* x y)
(let ((z (make-connector)))
(multiplier x y z)
z))
(define (c/ x y)
(let ((z (make-connector)))
(multiplier z y x)
z))
(define (cv x)
(let ((z (make-connector)))
(constant x z)
z))
Exercise 3.38
a.
peter -> paul -> mary 110 90 45
peter -> mary -> paul 110 55 35
paul -> mary -> peter 80 40 50
paul -> peter -> mary 80 90 45
mary -> peter -> paul 50 60 40
mary -> paul -> peter 50 30 40
... 35 40 45 50
b.
たくさん。
p179からp187(3.5 ストリーム)まで飛ばす。schemeで並列処理は多分やらない。
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 a (stream-enumerate-interval 1 10))
(display-stream a)
(define b (stream-map (lambda (x) (* x x)) a))
(display-stream b)
(define c (stream-map (lambda (x) (* x 2)) a))
(display-stream c)
(define d (stream-map + a b c))
(display-stream d)
結果
1 2 3 4 5 6 7 8 9 10
1 4 9 16 25 36 49 64 81 100
2 4 6 8 10 12 14 16 18 20
4 10 18 28 40 54 70 88 108 130
Exercise 3.51
http://sicp.naochan.com/memo.pl?p=%CC%E4%C2%EA3.51
が正解っぽい。
(stream-map show (stream-enumerate-interval 0 10))
を評価すると
(stream-map show (stream-enumerate-interval 0 10))
-> (stream-map show (0 . (delay (stream-enumerate-interval 1 10))))
-> ((show 0)が評価される)
-> (0 . (delay (streamp-map show (delay (stream-enumerate-interval 1 10)))))
となる。従って
(define x (stream-map show (stream-enumerate-interval 0 10)))
を評価すると
0x
と印字される。
また、(stream-cdr x)すると結果は
(force (delay (streamp-map show (delay (stream-enumerate-interval 1 10)))))
-> (streamp-map show (delay (stream-enumerate-interval 1 10)))
-> (stream-map show (1 . (delay (stream-enumerate-interval 2 10))))
-> ((show 1)が評価される)
-> (1 . (delay (streamp-map show (delay (stream-enumerate-interval 2 10)))))
となる。
すなわちstream-cdrを施すごとにcarに出てくる数が印字される。
stream-refは第二引数と同じ回数だけstream-cdrを繰り返すので
(stream-ref x 5)
を評価すると
1
2
3
4
55
と印字される。(strea-ref x 7)も同様。
Exercise 3.52
ストリーム関係の手続きは、ここにあるstream.scmを使用するとSICPの意図する通りの動作をするようになる。
goshネイティブのものを使用するとSICP読者からしたら謎の動作をするので勉強にならない。
ここらへんの演習問題(3.50,51,52)は使用しているscheme処理系のストリーム実装に相当影響されてしまうので
gaucheで解くのは効率的でない気がする。何がSICPの意図する動作なのか分からない。
なので飛ばします。本文は良く読むことにする。
Exercise 3.53
1 2 4 8 16 ...
Exercise 3.54
(define factorial (cons-stream 1 (mul-streams factorial integers)))
Exercise 3.55
;表を書くと分かりやすい。
;partial-sums 1 3 6 10 15 ...
;integers 1 2 3 4 5 6 ...
;partial-sums 1 3 6 10 15 21 ...
(define (partial-sums s)
(cons-stream (stream-car s)
(add-stream (stream-cdr s)
(partial-sums s))))
;テスト
(st (partial-sums integers) 10)
; -> 1 3 6 10 15 21 28 36 45 55
Exercise 3.56
;2と3と5しか因数を持たない数の無限ストリーム。
(define S (cons-stream 1 (merge (merge (scale-stream integers 2)
(scale-stream integers 3))
(scale-stream integers 5))))
;実行結果
;1 2 3 4 5 6 8 9 10 12 14 15 16 18 20 21 22 24 25 26 27 28 30 32 33 34 35
;36 38 39 40 42 44 45 46 48 50 51 52 54 55 56 57 58 60 62 63 64 65 66 68 69
;70 72 74 75 76 78 80 81 82 84 85 86 87 88 90 92 93 94 95 96 98 99 100 102
;104 105 106 108 110 111 112 114 115 116 117 118 120 122 123 124 125 126 128
;129 130 132 134 135
Exercise 3.57
分かりません。
Exercise 3.58
(expand num den radex)
…radix進数におけるnum/denの小数点以下を表すストリーム。
(expand 1 7 10)
は1/7が循環小数0.142857....なので
(1 4 2 8 5 7....)
となる。
(expand 1 8 10)
は1/8が0.125なので
(1 2 5 0 0 0 ...)
となる。
Exercise 3.59
a.
;(integersは(1 2 3 ...)を表す無限リスト)
(define (integrate-series s)
(stream-map / s integers))
b.
;ヒントがまたギッリギリな感じです。
(define cosine-series
(cons-stream 1 (stream-map - (integrate-series sine-series))))
(define sine-series
(cons-stream 0 (integrate-series cosine-series)))
Exercise 3.60
; 分かりませんでした。答えはここ参照。
; http://plnet.jp/lurker/51006
(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 (mul-series sine-series sine-series))
(define cos^2 (mul-series cosine-series cosine-series))
(show-stream sin^2 15)
(show-stream cos^2 15)
; とすると
; 0 0 1 0 -1/3 0 2/45 0 -1/315 0 2/14175 0 -2/467775 0 4/42567525
; 1 0 -1 0 1/3 0 -2/45 0 1/315 0 -2/14175 0 2/467775 0 -4/42567525
; となって、最初の1以外見事に符号が逆転していることが分かる。従って
(add-streams sin^2 cos^2)
; の和はいつでも0。
Exercise 3.61
(define (invert-unit-series S)
(cons-stream 1
(mul-series (stream-map - (stream-cdr S))
(invert-unit-series S))))
(invert-unit-series (invert-unit-series integers))
=> 1 2 3 4 5 6 7 8 9 10
Exercise 3.62
;間違ってる。分からん。
(define (div-series s1 s2)
(mul-series s1
(invert-unit-series s2)))
これと、前の結果を用いて
(define tan-series
(div-series sine-series cosine-series))
3.5.3
「ストリームパラダイムの開発は」かなり勉強になる。
平方根のストリーム、並び加速、タブロー。面白いっす。
でも趣味の世界に突入しそうです。。。
| Home |