問題4.71-4.75
久しぶりに。Schemeはやっぱり楽しい。続き。
4.71
Louisの手続きでdelayが取り除かれた箇所はapply-rulesとdisjoinの再帰部分ですね。とりあえずわかんないのでdelayedでないstream-appendとinterleaveを書いてみます。
(define (stream-append s1 s2) (if (stream-null? s1) s2 (cons-stream (stream-car s1) (stream-append (stream-cdr s1) s2)))) (define (interleave s1 s2) (if (stream-null? s1) s2 (cons-stream (stream-car s1) (interleave s2 (stream-cdr s1)))))
ついでにLouisのも書いてみます。
(define (simple-query query-pattern frame-stream) (stream-flatmap (lambda (frame) (stream-append (find-assertions query-pattern frame) (apply-rules query-pattern frame))) frame-stream)) (define (disjoin disjuncts frame-stream) (if (empty-disjunction? disjuncts) the-empty-stream (interleave (qeval (first-disjunct disjuncts) frame-stream) (disjoin (rest-disjuncts disjuncts) frame-stream))))
うーん考えてもわかんない。こういうときはググります。...なるほど。
disjoinを考えてみます。再帰だからinterleaveの入れ子みたいな感じになるはず。qevalは拡張されたフレームのストリームを生成するから、それがinterleaveの引数に渡される。そうすると、disjoinは質問言語のorを処理する関数で、disjunctsはorの各引数なので、
(or <exp1> <exp2> ... <expn> ...)
のような場合について、まず
;;; Query input: (reverse (a b c) ?x) ;;; Query results: (reverse (a b c) (c b a)) ;;; Query input: (reverse ?x (a b c)) ;;; Query results: . user break
こんなものがありました。なのでこれとorを使ってとてもわざとらしい例を作ってみたいと思います。まずはdelayedを使った評価器。
;;; Query input: (or (son Adam ?x) (reverse ?y (a b c))) ;;; Query results: (or (son Adam Cain) (reverse ?y (a b c))) . user break
ちゃんと値を一つは生成してくれます。次にLouisの手続きを使った評価器。
;;; Query input: (or (son Adam ?x) (reverse ?y (a b c))) ;;; Query results: . user break
一つも生成してくれません。ということでdelayを使った方が最悪無限ループに陥ってもいくつか有用な値を得られるという点で有効のようです。
4.72
interleaveは二つのストリームs1とs2を混ぜ合わせるものでした。なんぜこんなことしなきゃいけないのかですが、単にstream-appendした場合、s1が無限ストリームだったりしたら永遠にs2の出番が廻ってこないからです。なのでinterleave-delayedを使うと、s1が無限、s2が有限の質問をしてもs2でマッチしたものはちゃんと全部出てくるという結果になるはず(s1,s2ともに無限でも偏った順に結果が出てくるということはないということも言えます)。
;;; Query input: (or (last-pair ?x (3)) (son Ada ?y)) ;;; Query results: . user break
あれ？
あぁ、そうか、単に無限ループを持ってくるんじゃなくて、無限のストリームを生成する質問を持ってこないとだめなのか。うーんそんな質問あるかな。
ありました。p276。
;;; Query input: (assert! (rule (married ?x ?y) (married ?y ?x))) Assertion added to data base. ;;; Query input: (assert! (married Minn** Mick**)) Assertion added to data base. ;;; Query input: (married Mick** ?who) ;;; Query results: (married Mick** Minn**) (married Mick** Minn**) (married Mick** Minn**) ...
こいつらをそのまま扱うのは怖いのでぼかします。試してみます。
;;; Query input: (or (married Mick** ?who) (son Ada ?x)) ;;; Query results: (or (married Mick** Minn**) (son Ada ?x)) (or (married Mick** ?who) (son Ada Jubal)) (or (married Mick** Minn**) (son Ada ?x)) (or (married Mick** ?who) (son Ada Jabal)) (or (married Mick** Minn**) (son Ada ?x)) (or (married Mick** Minn**) (son Ada ?x)) ...
ということでちゃんとJubalとJabalが出てきてくれました。じゃあdisjoinをstream-append-delayedに変更して試してみます。
;;; Query input: (or (married Mick** ?who) (son Ada ?x)) ;;; Query results: (or (married Mick** Minn**) (son Ada ?x)) (or (married Mick** Minn**) (son Ada ?x)) (or (married Mick** Minn**) (son Ada ?x)) (or (married Mick** Minn**) (son Ada ?x)) ...
出てきません。ということで、interleaveは有効にはたらくようです(でも結構レアケースな気がするけど)。
4.73
streamが無限の時、flatten-streamの再帰が終わらないから。flatten-streamを問題文のように変えてやってみます。
> (define ones (cons-stream 1 ones)) > (define integers (cons-stream 1 (stream-map + ones integers))) > (disp-stream (flatten-stream integers) 20) . user break
ということでだめです。
4.74
a.
flatten-streamの動作を見てみます。
> (define ones (cons-stream 1 ones)) > (define twos (cons-stream 2 twos)) > (define integers (cons-stream 1 (stream-map + ones integers))) > (define 2^n (cons-stream 1 (stream-map * twos 2^n))) > (define s (cons-stream (cons-stream ones the-empty-stream) (cons-stream (cons-stream twos (cons-stream integers the-empty-stream)) (cons-stream (cons-stream 2^n the-empty-stream) the-empty-stream)))) > (define fs (flatten-stream s)) > (disp-stream (stream-ref fs 0) 10) (1 1 1 1 1 1 1 1 1 1) > (disp-stream (stream-ref fs 1) 10) (2 2 2 2 2 2 2 2 2 2) > (disp-stream (stream-ref fs 2) 10) (1 2 4 8 16 32 64 128 256 512) > (disp-stream (stream-ref fs 3) 10) (1 2 3 4 5 6 7 8 9 10)
CLのMAPCANの非破壊的なもののストリームバージョンで、interleaveによる混ぜ合わせが組み込まれてます。Alyssaの要求にしたがってinterleaveを取り除くとこんな感じになるはずです。
(define (simple-stream-flatmap proc s) (simple-flatten (stream-map proc s))) (define (simple-flatten stream) (stream-map stream-car (stream-filter (lambda (s) (not (stream-null? s))) stream)))
空ストリームか単一ストリームのみを生じるのでstream-carでおけーです。実験してみます。
> (define ones (cons-stream 1 ones)) > (define twos (cons-stream 2 twos)) > (define integers (cons-stream 1 (stream-map + ones integers))) > (define 2^n (cons-stream 1 (stream-map * twos 2^n))) > (define s (cons-stream (cons-stream ones the-empty-stream) (cons-stream (cons-stream twos the-empty-stream) (cons-stream (cons-stream integers the-empty-stream) (cons-stream (cons-stream 2^n the-empty-stream) the-empty-stream))))) > (define fs (simple-flatten s)) > (disp-stream (stream-ref fs 0) 10) (1 1 1 1 1 1 1 1 1 1) > (disp-stream (stream-ref fs 1) 10) (2 2 2 2 2 2 2 2 2 2) > (disp-stream (stream-ref fs 2) 10) (1 2 3 4 5 6 7 8 9 10) > (disp-stream (stream-ref fs 3) 10) (1 2 4 8 16 32 64 128 256 512)
ちゃんと動きます。単一ストリームのみということなのでsは前のと変えてあります。
b.
Alyssaは頭いいからたぶん変わらない。
interleaveを導入するのは無限ストリームとかに対応するためだけど、それが生じない場合なら別にいらない。Alyssaの言い分ではnegate,lisp-value,find-assertionsは空ストリームか単一のストリームしか返さないので、実際そうなら動作は変わらないはず。
コードを見てみるとどれも戻ってくる値はthe-empty-streamかsingleton-streamで生成したもので、singleton-streamは
(define (singleton-stream x) (cons-stream x the-empty-stream))
なので単一ストリームを生成するからstream-carで取り出せる。動作は変わらない。
4.75
uniqueを実装。手続きを表に格納しているから評価器に組み込むのは楽でいいですね。
notに類似ということなので、notに倣って書いてみます。
(define (uniquely-query exps) (car exps)) (define (uniquely-asserted contents frame-stream) (stream-flatmap (lambda (frame) (let ((result (qeval (uniquely-query contents) (singleton-stream frame)))) (if (and (not (stream-null? result)) (stream-null? (stream-cdr result))) result the-empty-stream))) frame-stream)) (put 'unique 'qeval uniquely-asserted)
試してみます。
;;; Query input: (unique (son Adam ?x)) ;;; Query results: (unique (son Adam Cain)) ;;; Query input: (unique (son Ada ?x)) ;;; Query results: ;;; Query input: (and (job ?x ?y) (unique (supervisor ?z ?x))) ;;; Query results: (and (job (Scrooge Eben) (accounting chief accountant)) (unique (supervisor (Cratchet Robert) (Scrooge Eben)))) (and (job (Hacker Alyssa P) (computer programmer)) (unique (supervisor (Reasoner Louis) (Hacker Alyssa P))))
どうやら合っているようです。
今日はここまで。次で4章終わりです。
