SICP 読書ノート#71 - 5.1 レジスタ計算機の設計 (pp.293-306)
色々と忙しくてサボってましたが、約半年ぶりに再開します。
Schemeを忘れていないかと心配でしたが、 4章までの苦労が染み付いてたせいか案外そうでもなかった。よかった！
5章を学ぶ意味
5章の冒頭にまとめてあります。
問題 5.1
テキストのgcdの例を参考に見よう見まねでやってみる。
factorialのデータパス図。
factorialの制御図。
問題 5.2
問題5.1のfactorialをレジスタマシン言語を使って書き直す。
アセンブリを書いているような気分。
ラベルの管理はどうしてるんだろうとか、testの結果は
特殊なレジスタに格納されるんだろなと色々と想像させられる。
(controller (assign product (const 1)) (assign counter (const 1)) test-counter (test (op >) (reg counter) (reg n)) (branch (label factorial-done)) (assign product (op *) (reg product) (reg counter)) (assign counter (op +) (reg counter) (const 1)) (goto (label test-counter)) factorial-done)
問題 5.3
§1.1.7のニュートン法によって平方根を求めるマシンを設計する。
まずはデータパス図。
制御図は面倒なので省略。
マシン言語での実装。
(controller (assign x (op read)) (assign guess (const 1.0)) test-good-enough? (test (op good-enough?) (reg guess) (reg x)) (branch (label sqrt-done)) (assign guess (op remove) (reg guess) (reg x)) (goto (label test-good-enough?)) sqrt-done)
サブルーチンについて
サブルーチンと言えばスタックが必要になると思うが、
factorialのマシン言語の実装においても実際にそうなのか、
コントローラの命令シーケンス(instruction sequence)を追ってみた。
(controller (assign continue (label fact-done)) ; set up final return address fact-loop (test (op =) (reg n) (const 1)) (branch (label base-case)) ;; Set up for the recursive call by saving n and continue. ;; Set up continue so that the computation will continue ;; at after-fact when the subroutine returns. (save continue) (save n) (assign n (op -) (reg n) (const 1)) (assign continue (label after-fact)) (goto (label fact-loop)) after-fact (restore n) (restore continue) (assign val (op *) (reg n) (reg val)) ; val now contains n * (n-1)! (goto (reg continue)) ; return to caller base-case (assign val (const 1)) ; base case: 1!=1 (goto (reg continue)) ; return to caller fact-done)
結果は以下の通り。サブルーチンの処理を実行する直前に
それまでの途中の処理(=レジスタの値)をstackにsaveする。
そして、サブルーチンの処理が完了すると、
saveされた処理がrestoreされて途中だった処理を継続する。
| step | instruction | val | n | continue | stack |
|---|---|---|---|---|---|
| 1 | (assign continue (label fact-done) |
3 |
(label fact-done) |
||
fact-loop 1回目 |
|||||
| 2 | (test (op =) (reg n) (const 1)) |
↓ | ↓ | ||
| 3 | (save continue) |
↓ | ↓ | (label fact-done) |
|
| 4 | (save n) |
↓ | ↓ | 3(label fact-done) |
|
| 5 | (assign n (op -) (reg n) (const 1)) |
2 |
↓ | ↓ | |
| 6 | (assign continue (label after-fact)) |
↓ | (label after-fact) |
↓ | |
| 7 | (goto (label fact-loop)) |
↓ | ↓ | ↓ | |
fact-loop 2回目 |
|||||
| 8 | (test (op =) (reg n) (const 1)) |
↓ | ↓ | ↓ | |
| 9 | (save continue) |
↓ | ↓ | (label after-fact)3(label fact-done) |
|
| 10 | (save n) |
↓ | ↓ | 2(label after-fact)3(label fact-done) |
|
| 11 | (assign n (op -) (reg n) (const 1)) |
1 |
↓ | ↓ | |
| 12 | (assign continue (label after-fact)) |
↓ | (label after-fact) |
↓ | |
| 13 | (goto (label fact-loop)) |
↓ | ↓ | ↓ | |
fact-loop 3回目 |
|||||
| 14 | (test (op =) (reg n) (const 1))=> testの結果は真となる |
↓ | ↓ | ↓ | |
| 15 | (branch (label base-case)) |
↓ | ↓ | ↓ | |
base-case 1回目 |
|||||
| 16 | (assign val (const 1)) |
1 |
↓ | ↓ | ↓ |
| 17 | (goto (reg continue)) |
↓ | ↓ | ↓ | ↓ |
after-fact 1回目 |
|||||
| 18 | (restore n) |
↓ | 2 |
↓ | (label after-fact)3(label fact-done) |
| 19 | (restore continue) |
↓ | ↓ | (label after-fact) |
3(label fact-done) |
| 20 | (assign val (op *) (reg n) (reg val)) |
2 |
↓ | ↓ | ↓ |
| 21 | (goto (reg continue)) |
↓ | ↓ | ↓ | ↓ |
after-fact 2回目 |
|||||
| 22 | (restore n) |
↓ | 3 |
↓ | (label fact-done) |
| 23 | (restore continue) |
↓ | ↓ | (label fact-done) |
|
| 24 | (assign val (op *) (reg n) (reg val)) |
6 |
↓ | ↓ | |
| 25 | (goto (reg continue)) |
↓ | ↓ | ↓ | |
fact-done |
問題 5.4
再帰的プロセスだとスタックが必ず必要、 反復的プロセスだと末尾再帰ならスタック不要、ということが言いたいんだと思う。
(a) 再帰的プロセス
(controller (assign continue (label expt-done)) expt-loop (test (op =) (reg n) (const 0)) (branch (label base-case)) (save continue) (save n) (assign n (op -) (reg n) (const 1)) (goto (label expt-loop)) after-expt (restore n) (restore continue) (assign product (op *) (reg b) (reg product)) (goto (reg controller)) base-case (assign product (const 1)) (goto (reg continue)) expt-done)
データパス図。スタックから値を取り出す度にproductにbの値を掛け合わせて行く。
命令列のシーケンスは面倒なのでパス。
(b) 反復的プロセス
(controller (assign continue (reg n)) (assign product (const 1)) expt-loop (test (op =) (reg counter) (const 0)) (branch (label expt-done)) (assign counter (op -) (reg counter) (const 1)) (assign product (op *) (reg b) (reg product)) (goto (label expt-loop)) expt-done)
データパス図。スタックがない分スッキリ。
初期値nのcounterを減らす度にproductにbを掛け合わせて行く。
アプリケーションからマシン語まで抽象レイヤーを降りてきても、 §1の初めの方でやったことがちゃんとつながるのが、SICPの凄いところだなあ。
問題 5.6
(save continue)と(restore continue)はなくても動く。
問題5.5と5.7はスキップで。
次は「§5.2 レジスタ計算機シミュレータ」から。
SICP 読書ノート#70 - 第4章 まとめ
途切れ途切れながらも半年かかって4章が終わりました。終盤はゴニョゴニョしましたが…
あらためてSICPがどのような本か、高橋征義さんのブログでの以下の言及が素晴らしいです。
少なくとも私にとってSICPとは、「プログラム」そして「プログラミング」という営為の見方を変えるもの、もっと言うと世界に対する見方、すなわち「世界観」を与えてくれるものなのです。
その世界観とは何か。ずばりまとめてみましょう。
・「新たなプログラムを作るということは、新たなプログラミング言語を作ることである」
・「世界はプログラムで表現できる」
・すなわち、「世界とは、ある種のプログラミング言語処理系である」
これです。これ。プログラミング言語好きにはなんと都合のいい世界観でしょう。でも、わりとそういう読み方を素直に許してくれるような本だと思うんですよ。
この「すべてのプログラム・世界はある種の処理系という世界観」にものすごく共感したのを覚えています。特に4章を読んでいくうちに「言語処理系のユーザーから言語処理系の設計者になってしまうことが、ソフトウェアエンジニアの技術向上には大いに役立つのではないか」という考えに至り、僕の中でSICPを読む目的がより鮮明になりました。
また、4章では、超循環評価器、継続を用いた非決定性計算、多方向性計算による質問システムのように様々な処理系が登場しますが、こういった処理系の上で、図形言語、銀行口座、デジタル回路シミュレータ、論理パズル、質問言語などのより実世界のモデルに近い処理系が動いているわけで、プログラミングの世界とはまさに処理系の抽象化を重ねて構築されているわけです。今までもそういう構築が成されていることは頭の中のイメージできているつもりでしたが、実際に手を動かして学ぶことでそれらがより明確になってくれた気がします。
しかも、これらを実装する中で、データや手続きによる抽象、環境モデル、遅延評価、ストリームなど知識も顔を出します。これらの要素ひとつひとつはプログラムを作る上でも重要ですが、処理系を作る上でも非常に重要であるいう点もおもしろいと思います。
ただ、1〜3章と比べて抽象レベルが格段に上がったためか、理解があやふやな感は正直否めません。それでも処理系の設計思想や大まかな概念は掴めたことは、自分の中でとても大きいです。
5章はレジスタマシンの実装をするようですが、これまでの流れを汲み取ると、ゴールはレジスタマシン上でScheme処理系を動かすことになるでしょう。個人的には未知の領域ですが、何処まで行けるか楽しみです。
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ではユニフィケーションの細部を理解する必要がありそうだが、 そこまでできていない。。。
これで４章が終わったので、次回はまとめます。
SICP 読書ノート#68 - 4.4.4 質問システムの実装(2) (pp.278-292)
重い腰をあげてquery systemの評価の流れをかんたんに追いました。
それとtraceとDrRacketによるデバッグ実行が便利だった。後でブログにまとめよう。
REPL
query-syntax-processでクエリをパースする- パースしたクエリが
assert!の場合は、そのassertionまたはruleをデータベースに追加する assert!以外の場合は、qevalでクエリを評価する
(define (query-driver-loop) (prompt-for-input input-prompt) (let ((q (query-syntax-process (read)))) (cond ((assertion-to-be-added? q) (add-rule-or-assertion! (add-assertion-body q)) (newline) (display "Assertion added to data base.") (query-driver-loop)) (else (newline) (display output-prompt) ;; [extra newline at end] (announce-output output-prompt) (display-stream (stream-map (lambda (frame) (instantiate q frame (lambda (v f) (contract-question-mark v)))) (qeval q (singleton-stream '())))) (query-driver-loop)))))
データベース
assertions(表明)とrules(規則)のリストがそれぞれグローバル変数に格納されている。
assertionsはデータベースのレコードに相当する。
racket@ch4-query.scm> (stream->list THE-ASSERTIONS) '((meeting whole-company (Wednesday 4pm)) (meeting administration (Friday 1pm)) (meeting computer (Wednesday 3pm)) (meeting administration (Monday 10am)) (meeting accounting (Monday 9am)) (can-do-job (administration secretary) (administration big wheel)) (can-do-job (computer programmer) (computer programmer trainee)) (can-do-job (computer wizard) (computer technician)) (can-do-job (computer wizard) (computer programmer)) (supervisor (Aull DeWitt) (Warbucks Oliver)) (salary (Aull DeWitt) 25000) (job (Aull DeWitt) (administration secretary)) (address (Aull DeWitt) (Slumerville (Onion Square) 5)) (supervisor (Cratchet Robert) (Scrooge Eben)) (salary (Cratchet Robert) 18000) (job (Cratchet Robert) (accounting scrivener)) (address (Cratchet Robert) (Allston (N Harvard Street) 16)) (supervisor (Scrooge Eben) (Warbucks Oliver)) (salary (Scrooge Eben) 75000) (job (Scrooge Eben) (accounting chief accountant)) (address (Scrooge Eben) (Weston (Shady Lane) 10)) ...
rulesは規則の並び。
racket@ch4-query.scm> (stream->list THE-RULES)
'((rule
(meeting-time (? person) (? day-and-time))
(or (and (job (? person) ((? division) ? type))
(meeting (? division) (? day-and-time)))
(meeting whole-company (? day-and-time))))
(rule
(big-shot (? person))
(and (supervisor (? person) (? boss)) (not (replace (? boss) (? person)))))
(rule
(replace (? person-1) (? person-2))
(and (job (? person-1) (? job-1))
(job (? person-2) (? job-2))
(or (same (? job-1) (? job-2)) (can-do-job (? job-1) (? job-2)))
(not (same (? person-1) (? person-2)))))
(rule
(outranked-by (? staff-person) (? boss))
(or (supervisor (? staff-person) (? boss))
(and (supervisor (? staff-person) (? middle-manager))
(outranked-by (? middle-manager) (? boss)))))
(rule
(wheel (? person))
(and (supervisor (? middle-manager) (? person))
(supervisor (? x) (? middle-manager))))
(rule (same (? x) (? x)))
(rule
(lives-near (? person-1) (? person-2))
(and (address (? person-1) ((? town) ? rest-1))
(address (? person-2) ((? town) ? rest-2))
(not (same (? person-1) (? person-2))))))
パーサー
クエリに含まれる変数を?シンボルで始まるリストに置換する。
racket@ch4-query.scm> (query-syntax-process '(job ?x ?y)) '(job (? x) (? y)) racket@ch4-query.scm> (query-syntax-process '(and (job ?person (computer programmer)) (address ?person ?where))) '(and (job (? person) (computer programmer)) (address (? person) (? where)))
クエリの評価
クエリの評価を行うqevalは、そのクエリとフレームストリームを引数に取る。
- 単純質問の場合は
simple-queryを適用する - 単純質問以外の場合は
qprocに取り出された手続きを適用する
(define (qeval query frame-stream) (let ((qproc (get (type query) 'qeval))) (if qproc (qproc (contents query) frame-stream) (simple-query query frame-stream))))
この振る舞いは超循環評価器のevalとapplyの関係に似ている。
単純質問
単純質問(simple query)の以下の例について、クエリの評価の流れをtraceを使って追ってみる。
;;; Query input: (job ?x ?y) ;;; Query results: (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))
simple-queryで出力されるフレームストリームは変数?x、?yに束縛される値の並びとなる。
racket@ch4-query.scm> (require racket/trace) racket@ch4-query.scm> (trace find-assertions) racket@ch4-query.scm> (trace fetch-assertions) racket@ch4-query.scm> (stream->list (simple-query '(job (? x) (? y)) (singleton-stream '()))) >(find-assertions '(job (? x) (? y)) '()) > (fetch-assertions '(job (? x) (? y)) '()) < #<stream> <#<stream> '((((? 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)))
またfetch-assertionsはデータベースからクエリにヒットするassertionを取り出す手続きである。
このfetch-assertionsだけを実行してみると以下のようになる。
racket@ch4-query.scm> (stream->list (fetch-assertions '(job (? x) (? y)) (singleton-stream '()))) >(fetch-assertions '(job (? x) (? y)) #<stream>) <#<stream> '((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)))
つまりsimple-queryの処理の流れをまとめると、
fetch-assertionsでインデックス(=先頭のシンボル)がjobで始まるassertionを抽出するfind-assertionsで1で取り出したassertionsに対しパターンマッチを行い、?x、?yのマッチ結果をフレームストリームで返すapply-rulesは今回の場合、空のフレームストリームを返すsimple-queryは3と4のフレームストリームをつなげて返す
といったことを行っている。
図で表すと以下の通り。
インスタンス化
instantiateは出力フレームストリームからフレームをひとつずつ取り出し、
クエリの変数にマッチさせた結果を出力する。
query = (job (? x) (? y))の出力フレームストリームをoutput-framesとすると、
racket@ch4-query.scm> (define output-frames (simple-query '(job (? x) (? y)) (singleton-stream '()))) racket@ch4-query.scm> (stream->list output-frames) '((((? 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)))
この出力フレームをinstantiateに与えると、元のクエリの変数にフレームの内容が割り当てられる。
racket@ch4-query.scm> (define instantated-frames (stream-map (lambda (frame) (instantiate '(job (? x) (? y)) ;; 元のクエリ frame (lambda (v f) (contract-question-mark v)))) output-frames)) racket@ch4-query.scm> (stream->list instantated-frames) '((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)))
andクエリ
以下の例について考える。
;;; Query input: (and (job ?who (computer programmer)) (address ?who ?where)) ;;; Query results: (and (job (Fect Cy D) (computer programmer)) (address (Fect Cy D) (Cambridge (Ames Street) 3))) (and (job (Hacker Alyssa P) (computer programmer)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)))
合成質問の場合、qevalのqprocで何らかの手続きが取り出されそれが適用される。
クエリのインデックスがandの場合はqprocにconjoinが取り出され、conjoinには以下のような引数が適用される。
racket@ch4-query.scm> (stream->list (conjoin '((job (? who) (computer programmer)) (address (? who) (? where))) (singleton-stream '()))) '((((? where) Cambridge (Ames Street) 3) ((? who) Fect Cy D)) (((? where) Cambridge (Mass Ave) 78) ((? who) Hacker Alyssa P)))
conjoinの動きをtraceを使って詳しく追うと、
racket@ch4-query.scm> (trace conjoin) racket@ch4-query.scm> (trace simple-query) racket@ch4-query.scm> (stream->list (conjoin '((job (? who) (computer programmer)) (address (? who) (? where))) (singleton-stream '()))) >(conjoin '((job (? who) (computer programmer)) (address (? who) (? where))) #<stream>) ;; 1. conjoinの先頭クエリ(job (? who) (computer programmer))をsimple-queryに適用 > (simple-query '(job (? who) (computer programmer)) #<stream>) < #<stream> ;; 2. conjoinのクエリが(address (? who) (? where))となり ;; 1の出力フレームが入力フレームに与えられる >(conjoin '((address (? who) (? where))) #<stream>) ;; 3. (address (? who) (? where))をsimple-queryに適用。 ;; whoは入力フレームで束縛されるため ;; whoがこれにマッチしないassertionは出力されない > (simple-query '(address (? who) (? where)) #<stream>) < #<stream> ;; 4. conjoinのクエリが'()となり ;; 3の出力フレームが入力フレームに与えられ、そのままそれが出力される >(conjoin '() #<stream>) <#<stream> '((((? where) Cambridge (Ames Street) 3) ((? who) Fect Cy D)) (((? where) Cambridge (Mass Ave) 78) ((? who) Hacker Alyssa P)))
図で表すと以下の通り。
orクエリ
以下の例について考える。
;;; 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)))
出力フレームは以下の通り。
racket@ch4-query.scm> (stream->list (disjoin '((supervisor (? who) (Bitdiddle Ben)) (supervisor (? who) (Hacker Alyssa P))) (singleton-stream '()))) '((((? who) Tweakit Lem E)) (((? who) Reasoner Louis)) (((? who) Fect Cy D)) (((? who) Hacker Alyssa P)))
処理の流れは割愛。図で表すと以下の通り。
フィルタ
以下の例について考える。
;;; Query input: (and (supervisor ?who (Bitdiddle Ben)) (not (job ?who (computer programmer)))) ;;; Query results: (and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer))))
出力フレームは以下の通り。
racket@ch4-query.scm> (stream->list (qeval '(and (supervisor (? who) (Bitdiddle Ben)) (not (job (? who) (computer programmer)))) (singleton-stream '()))) '((((? who) Tweakit Lem E)))
図で表すと以下の通り。notクエリはフィルタとして働くため、
(supervisor (? who) (Bitdiddle Ben)にマッチしたフレームに対し
(job (? who) (computer programmer)でマッチするものを取り除く。
規則とユニフィケーション
本文で出てきたruleのひとつlives-nearの動きを見てみる。
(rule (lives-near ?person-1 ?person-2) (and (address ?person-1 (?town . ?rest-1)) (address ?person-2 (?town . ?rest-2)) (not (same ?person-1 ?person-2))))
質問システムの出力は以下の通り。
;;; Query input: (lives-near ?who (Bitdiddle Ben)) ;;; Query results: (lives-near (Aull DeWitt) (Bitdiddle Ben)) (lives-near (Reasoner Louis) (Bitdiddle Ben))
この時の出力フレームは以下のようになっている。
racket@ch4-query.scm> (stream->list (qeval '(lives-near (? who) (Bitdiddle Ben)) (singleton-stream '()))) '((((? 1 rest-2) (Ridge Road) 10) ((? 1 rest-1) (Onion Square) 5) ((? 1 town) . Slumerville) ((? 1 person-1) Aull DeWitt) ((? 1 person-2) Bitdiddle Ben) ((? who) ? 1 person-1)) (((? 1 rest-2) (Ridge Road) 10) ((? 1 rest-1) (Pine Tree Road) 80) ((? 1 town) . Slumerville) ((? 1 person-1) Reasoner Louis) ((? 1 person-2) Bitdiddle Ben) ((? who) ? 1 person-1)))
まず、(lives-near (? who) (Bitdiddle Ben))のクエリは
THE-ASSERTIONSにはなくTHE-RULESにあるため、apply-rulesによって取り出される。
apply-rulesの実体であるapply-a-ruleの実装を追うと、
ruleの本体のクエリをqevalで評価させていることが分かる。
(define (apply-a-rule rule query-pattern query-frame) (let ((clean-rule (rename-variables-in rule))) (let ((unify-result (unify-match query-pattern (conclusion clean-rule) query-frame))) (if (eq? unify-result 'failed) the-empty-stream (qeval (rule-body clean-rule) (singleton-stream unify-result))))))
今回の例の場合、具体的には
- qevalに与えられるクエリは、ruleのbody(本体)
'(and (address (? 1 person-1) ((? 1 town) ? 1 rest-1)) (address (? 1 person-2) ((? 1 town) ? 1 rest-2)) (not (same (? 1 person-1) (? 1 person-2))))
- qevalに与えられるフレームは、ruleのconclusionにユニファイした結果
'(((? 1 person-2) Bitdiddle Ben) ((? who) ? 1 person-1))
となる。
ユニフィケーションでは、ruleに与えられたパターン(この例では(?who (Bitdiddle Ben)))と
ruleのconclusion(この例では(?person-1 ?person-2))でパターンマッチを行い、
束縛可能な変数を束縛する。
またフレームの変数名が重複しないように、?の後にユニークな識別子(上の例では1)を与える。
識別子を付与する手続きはmake-new-variableである。
(define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var))))
ruleのbodyとユニファイ結果が与えられたqevalは既述のクエリと同じように評価される。
図で表すと以下の通り。
query systemの細部まで追いかけて理解したわけじゃないけど、 深追いもよくないのでこの辺で止めて次回は練習問題をやります。
参考リンク
以下のブログが分かりやすくてよかったです。
SICP 読書ノート#67 - 4.4.4 質問システムの実装(1) (pp.278)
§4.4.4に入り質問システムの実装を追っていたのですが、詰まってしまいました。
stream-append-delayedやinterleave-delayedのストリーム操作がよくわからない- 「§3.5.3 ストリームパラダイムの開発」の前半部で登場していたようだが、思いっきり読み飛ばしていた
- 仕方がないので§3.5.3を読み返す
- これまでストリームは
racket/streamを流用していたが、それでは問題3.63が上手く解けない - SICPの本文を参考にストリームを再実装しよう
で、ストリームをこんな感じで再実装しています。
#lang racket (define (memo-proc proc) (let ((already-run? false) (result false)) (define promise (lambda () (if (not already-run?) (begin (set! result (proc)) (set! already-run? true) result) result))) promise)) #| ;; non-memozing stream (define-syntax cons-stream (syntax-rules () ((_ a b) (cons a (lambda () b))))) |# ;; memoizing stream (define-syntax cons-stream (syntax-rules () ((_ a b) (cons a (memo-proc (lambda () b)))))) (define (stream-car s) (car s)) (define (stream-cdr s) ((cdr s))) (define (stream-null? s) (null? s)) (define the-empty-stream '()) ;; ... (provide (all-defined-out))
これを使って、これまで実装したコードの動作を確認中。結構時間がかかりそう…
(2015/08/21追記) ストリームのコードをGitHubに置きました。
§3.5.3でやり直している問題は、§3.5.3 ストリームパラダイムの開発の記事に追記していく予定。
(2015/09/06追記) §3.5.3の記事に追記しました。
