SICP 読書ノート#69 - 4.4.4 質問システムの実装(3) (pp.278-292)
§4.4.4の練習問題から。
問題 4.70
以下のadd-assertion!の実装の何が悪いかを説明せよ。
(define (add-assertion! assertion) (store-assertion-in-index assertion) (set! THE-ASSERTIONS (cons-stream assertion THE-ASSERTIONS)) 'ok)
オリジナルの実装は以下の通り。
(define (add-assertion! assertion) (store-assertion-in-index assertion) (let ((old-assertions THE-ASSERTIONS)) (set! THE-ASSERTIONS (cons-stream assertion old-assertions)) 'ok))
新しいadd-assertion!の実装を見せられると
オリジナルの方のold-assertionsが冗長に見えるがそんなことはない。
新しい実装ではTHE-ASSERTIONSが循環してしまっているため、
stream-refの結果が同じassertionになってしまう。
(stream-ref THE-ASSERTIONS 0) => assertion (stream-ref THE-ASSERTIONS 1) => assertion (stream-ref THE-ASSERTIONS 2) => assertion ...
オリジナルの実装ではold-assertionsをたどっていくため正しく機能する。
(stream-ref THE-ASSERTIONS 0) => assertion (stream-ref THE-ASSERTIONS 1) => (stream-car old-assertions) ...
問題 4.71
query systemの以下の手続きを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))))
普通の合成質問や規則であれば問題なく動く。
;;; Query input: (or (supervisor ?who (Bitdiddle Ben)) (supervisor ?who (Hacker Alyssa P))) ;;; Query results: (or (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (supervisor (Tweakit Lem E) (Hacker Alyssa P))) (or (supervisor (Reasoner Louis) (Bitdiddle Ben)) (supervisor (Reasoner Louis) (Hacker Alyssa P))) (or (supervisor (Fect Cy D) (Bitdiddle Ben)) (supervisor (Fect Cy D) (Hacker Alyssa P))) (or (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (supervisor (Hacker Alyssa P) (Hacker Alyssa P))) ;;; Query input: (lives-near ?who (Bitdiddle Ben)) ;;; Query results: (lives-near (Aull DeWitt) (Bitdiddle Ben)) (lives-near (Reasoner Louis) (Bitdiddle Ben))
ではdelayさせている理由とは何か？
考えてもわからない… そもそも有限のデータベースやフレームしか扱わない時点で ストリームを使う理由すらよくわからない。単純なリストでも実装できそうな気がするが。。
わからないのでググってみると、以下のブログが参考になりました。
なるほど。無限ループになるような質問の時の振る舞いが異なるとのこと。
例えば、orクエリで片方の質問は解が得られるがもう一方は無限ループとなるようなクエリで、
元々のdelayをさせている場合は、無限ループにハマるものの解はプリントされる。
;;; Query input: (or (married Mickey ?x) (job ?y (computer programmer))) ;;; Query results: (or (married Mickey ?who) (job ?y (computer programmer))) (or (married Mickey ?x) (job (Fect Cy D) (computer programmer))) (or (married Mickey ?who) (job ?y (computer programmer))) (or (married Mickey ?x) (job (Hacker Alyssa P) (computer programmer))) (or (married Mickey ?who) (job ?y (computer programmer))) (or (married Mickey ?who) (job ?y (computer programmer))) ;;=> 以降ずっと(or (job ?x (computer programmer)) (married Mickey ?who))のプリントが続く... user break
一方、Louisの提案の場合は、delayがない分
instantiateまでたどり着く前に無限ループにはまり続けるので、何もプリントされない。
;;; Query input: (or (married Mickey ?x) (job ?y (computer programmer))) ;;=> 何もプリントされない user break
問題 4.72
問題4.71 で見た通り、orクエリで一方が無限ループに入るようなクエリでも
interleaveで差し込みにしておくことでもう一方は表示されるから。
問題 4.73
delayを与えないflatten-streamの場合、
(define (flatten-stream stream) (if (stream-null? stream) the-empty-stream (interleave (stream-car stream) (flatten-stream (stream-cdr stream)))))
引数streamが無限ストリームの場合は返ってこなくなるから。
ただしquery systemでは、データベースのassertionsやrulesが有限であるため
上記のflatten-streamに入れ替えても正しく動作する。
問題 4.74
a.
simple-stream-flatmapの実装は以下の通り。
(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)))
動作確認。データベースに対し(job ?x ?y)のパターンで取得した
assertionsをjob-assertionsとする。
racket@ch4-query.scm> (define job-assertions (fetch-assertions '(job (? x) (? y)) (singleton-stream '()))) racket@ch4-query.scm> (stream->list job-assertions) '((job (Aull DeWitt) (administration secretary)) (job (Cratchet Robert) (accounting scrivener)) (job (Scrooge Eben) (accounting chief accountant)) (job (Warbucks Oliver) (administration big wheel)) (job (Reasoner Louis) (computer programmer trainee)) (job (Tweakit Lem E) (computer technician)) (job (Fect Cy D) (computer programmer)) (job (Hacker Alyssa P) (computer programmer)) (job (Bitdiddle Ben) (computer wizard)))
find-assertionsでパターンの変数の束縛結果からフレームストリームを生成する処理について。
ここでstream-flatmapを使ってる。
racket@ch4-query.scm> (stream->list (stream-flatmap (lambda (datum) (check-an-assertion datum '(job (? x) (? y)) '())) job-assertions)) '((((? y) administration secretary) ((? x) Aull DeWitt)) (((? y) accounting scrivener) ((? x) Cratchet Robert)) (((? y) accounting chief accountant) ((? x) Scrooge Eben)) (((? y) administration big wheel) ((? x) Warbucks Oliver)) (((? y) computer programmer trainee) ((? x) Reasoner Louis)) (((? y) computer technician) ((? x) Tweakit Lem E)) (((? y) computer programmer) ((? x) Fect Cy D)) (((? y) computer programmer) ((? x) Hacker Alyssa P)) (((? y) computer wizard) ((? x) Bitdiddle Ben)))
この処理をsimple-stream-flatmapに置き換えてみても結果は同じ。
racket@ch4-query.scm> (stream->list (simple-stream-flatmap (lambda (datum) (check-an-assertion datum '(job (? x) (? y)) '())) job-assertions)) '((((? y) administration secretary) ((? x) Aull DeWitt)) (((? y) accounting scrivener) ((? x) Cratchet Robert)) (((? y) accounting chief accountant) ((? x) Scrooge Eben)) (((? y) administration big wheel) ((? x) Warbucks Oliver)) (((? y) computer programmer trainee) ((? x) Reasoner Louis)) (((? y) computer technician) ((? x) Tweakit Lem E)) (((? y) computer programmer) ((? x) Fect Cy D)) (((? y) computer programmer) ((? x) Hacker Alyssa P)) (((? y) computer wizard) ((? x) Bitdiddle Ben)))
b.
問題 4.73で見たように元のflatten-streamにdelayが必要なのは無限ストリームを扱うため。
simple-flattenはdelayがなくとも無限ストリームを扱えるため、システムの振る舞いは変わらない。
問題 4.75
ヒントの通りnegateフィルタを参考にuniquely-assertedを実装する。
(unique <query-pattern>)について<query-pattern>と一致する
assertionsやrulesをqevalをつかって取得するには、以下のようにすればよい。
(define (uniquely-query exps) (car exps)) (let ((result-stream (qeval (uniquely-query contents) (singleton-stream frame)))) ...)
このresult-streamで得られるフレームは唯一の場合のみ、
出力フレームストリームとして返すようにuniquely-assertedを実装する。
(define (uniquely-query exps) (car exps)) (define (uniquely-asserted contents frame-stream) (stream-flatmap (lambda (frame) (let ((result-stream (qeval (uniquely-query contents) (singleton-stream frame)))) (if (and (not (stream-null? result-stream)) (stream-null? (stream-cdr result-stream))) result-stream the-empty-stream))) frame-stream)) ;;さらに (put 'unique 'qeval uniquely-asserted) で手続きを追加...
テスト。たぶん動いていそう。
;;; Query input: (unique (job ?x (computer wizard))) ;;; Query results: (unique (job (Bitdiddle Ben) (computer wizard))) ;;; Query input: (unique (job ?x (computer programmer))) ;;; Query results: ;;; Query input: (and (job ?x ?j) (unique (job ?anyone ?j))) ;;; Query results: (and (job (Aull DeWitt) (administration secretary)) (unique (job (Aull DeWitt) (administration secretary)))) (and (job (Cratchet Robert) (accounting scrivener)) (unique (job (Cratchet Robert) (accounting scrivener)))) (and (job (Scrooge Eben) (accounting chief accountant)) (unique (job (Scrooge Eben) (accounting chief accountant)))) (and (job (Warbucks Oliver) (administration big wheel)) (unique (job (Warbucks Oliver) (administration big wheel)))) (and (job (Reasoner Louis) (computer programmer trainee)) (unique (job (Reasoner Louis) (computer programmer trainee)))) (and (job (Tweakit Lem E) (computer technician)) (unique (job (Tweakit Lem E) (computer technician)))) (and (job (Bitdiddle Ben) (computer wizard)) (unique (job (Bitdiddle Ben) (computer wizard))))
問題 4.76-79
ここまでquery systemの概要をさらっと見た程度では解けなさそうなのでパスします。 少なくとも問題 4.76ではユニフィケーションの細部を理解する必要がありそうだが、 そこまでできていない。。。
これで４章が終わったので、次回はまとめます。
