(define input-prompt ";;; Query input:")
(define output-prompt ";;; Query results:")
(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)
(display-stream
(stream-map
(lambda (frame)
(instantiate q
frame
(lambda (v f)
(contract-question-mark v))))
(qeval q (singleton-stream '()))))
(query-driver-loop)))))
本章の他の評価器と同様に, 質問言語の式でも抽象構文を使う. 述語assertion-to-be-added?
や選択子add-assertion-bodyを含め, 式の構文の実装は4.4.4.7節にある.
add-rule-or-assertion!は4.4.4.5節で定義する.
入力の式を処理する前に, 駆動ループはより効率的に処理が出来る形へ式を構文的に変換する. これには パターン変数の表現の変更もある. 質問が具体化されると, 未束縛で残っている変数は, 印字の前に入力の表現へ逆変換される. これらの変換は二つの手続きquery-syntax-processとcontract-question-markで実行する(4.4.4.7節).
式を具体化するには, それをコピーし, 式の中の変数をその与えられたフレームのその値で取り替える. 値も変数を含み得るので(例えばユニフィケーションの結果, expの中の?xが?yに束縛され, ?yが次に5 に束縛される), それも具体化する. 変数が具体化出来ない時にとる行動は, instantiateへ手続き引数で与える.
(define (instantiate exp frame unbound-var-handler)
(define (copy exp)
(cond ((var? exp)
(let ((binding (binding-in-frame exp frame)))
(if binding
(copy (binding-value binding))
(unbound-var-handler exp frame))))
((pair? exp)
(cons (copy (car exp)) (copy (cdr exp))))
(else exp)))
(copy exp))
束縛を扱う手続きは4.4.4.8節で定義する.
(define (qeval query frame-stream)
(let ((qproc (get (type query) 'qeval)))
(if qproc
(qproc (contents query) frame-stream)
(simple-query query frame-stream))))
4.4.4.7節で定義するtypeとcontentsは, この特殊形式の抽象構文を実装する.
(define (simple-query query-pattern frame-stream)
(stream-flatmap
(lambda (frame)
(stream-append-delayed
(find-assertions query-pattern frame)
(delay (apply-rules query-pattern frame))))
frame-stream))
入力ストリーム各フレームに対し, データベースの全表明に対してパターンをマッチさせ, 拡張フレームのストリームを作るのに,
find-assertions(4.4.4.3節)を使い, 可能な規則をすべて作用させて拡張されたフレームのもう一つのストリームを作るのにapply-rules(4.4.4.4節)を使う. この二つのストリームは(stream-append-delayed 4.4.4.6節 を使い)組み合され, 与えられたパターンが, 元々のフレームと矛盾なく満足出来るすべての方法のストリームを作る(問題4.71 参照). 個々の入力フレームのストリームはstream-flatmap(4.4.4.6節)を使って組み合せ, 最初の入力ストリームのフレームのいずれをも与えられたパターンとマッチするように拡張するすべての方法の一つの大きなストリームを作る.
(define (conjoin conjuncts frame-stream)
(if (empty-conjunction? conjuncts)
frame-stream
(conjoin (rest-conjuncts conjuncts)
(qeval (first-conjunct conjuncts)
frame-stream))))
式(put 'and 'qeval conjoin)はand形式を見つけた時, conjoinへ振り分けるようqevalを設定する.
or質問も図4.6に示すように, 同様に扱う. orのそれぞれの選言肢[disjunct]に対する出力ストリームは別々に計算され, 4.4.4.6節の interleave-delayed手続きを使って混ぜ合せる. (問題4.71および4.72参照)
(define (disjoin disjuncts frame-stream)
(if (empty-disjunction? disjuncts)
the-empty-stream
(interleave-delayed
(qeval (first-disjunct disjuncts) frame-stream)
(delay (disjoin (rest-disjuncts disjuncts)
frame-stream)))))
(put 'or 'qeval disjoin)
連言肢と選言肢の構文に対する述語と選択子は, 4.4.4.7節にある.
(define (negate operands frame-stream)
(stream-flatmap
(lambda (frame)
(if (stream-null? (qeval (negated-query operands)
(singleton-stream frame)))
(singleton-stream frame)
the-empty-stream))
frame-stream))
(put 'not 'qeval negate)
lisp-valueはnotに似たフィルタである. ストリームの各フレームはパターンの変数を具体化するのに使い, 指示された述語を作用させ, 述語が偽を返したフレームは, 入力ストリームからフィルタで除去する. 未束縛のパターン変数があればエラーになる:
(define (lisp-value call frame-stream)
(stream-flatmap
(lambda (frame)
(if (execute
(instantiate
call
frame
(lambda (v f)
(error "Unknown pat var -- LISP-VALUE" v))))
(singleton-stream frame)
the-empty-stream))
frame-stream))
(put 'lisp-value 'qeval lisp-value)
述語を引数に作用させるexecuteは, 作用させる手続きを得るため, 述語の式をevalしなければならない. しかし引数は既に実際の引数であり, (Lispの)評価が引数を生じるような式ではないので, 評価してはならない. executeは基盤のLispシステムの evalとapplyを使って実装されていることに注意しよう.
(define (execute exp)
(apply (eval (predicate exp) user-initial-environment)
(args exp)))
always-true特殊形式は, 常に満足される質問を用意する. 内容(通常は空)を無視し, 入力ストリームのすべてのフレームを通過する. always-trueはrule-body選択子(4.4.4.7節)が, 本体なしで定義された 規則(その結論が常に満足されている規則)に本体を与えるのに使う.
(define (always-true ignore frame-stream) frame-stream) (put 'always-true 'qeval always-true)notとlisp-valueの構文を定義する選択子は4.4.4.7節にある.
(define (find-assertions pattern frame)
(stream-flatmap (lambda (datum)
(check-an-assertion datum pattern frame))
(fetch-assertions pattern frame)))
check-an-assertionは引数としてパターン, データオブジェクト(表明)とフレームをとり, 拡張されたフレームを含む単一要素のストリームか, マッチが失敗した時のthe-empty-streamを返す.
(define (check-an-assertion assertion query-pat query-frame)
(let ((match-result
(pattern-match query-pat assertion query-frame)))
(if (eq? match-result 'failed)
the-empty-stream
(singleton-stream match-result))))
基本になるパターンマッチャは, 記号failedか, 与えられたフレームの拡張を返す. マッチャの基本的な考えはパターンをデータに対し, 要素ごとにチェックし, パターン変数に対する束縛を蓄積することである. パターンとデータオブジェクトが同じなら,
マッチは成功し, これまで蓄積した束縛フレームを返す. そうでなく, パターンが変数なら, 既にフレームにある束縛と矛盾しない限り, 現在のフレームを変数のデータへの束縛で拡張する. パターンとデータが共に対なら, (再帰的に)パターンのcarをデータのcarにマッチさせ, フレームを作る. 次にこのフレームで, パターンのcdrとデータのcdrをマッチさせる. こういうことが何も出来なければ, マッチは失敗し, 記号failedを返す.
(define (pattern-match pat dat frame)
(cond ((eq? frame 'failed) 'failed)
((equal? pat dat) frame)
((var? pat) (extend-if-consistent pat dat frame))
((and (pair? pat) (pair? dat))
(pattern-match (cdr pat)
(cdr dat)
(pattern-match (car pat)
(car dat)
frame)))
(else 'failed)))
既に存在する束縛と矛盾しなければ, フレームに新しい束縛を追加することで, フレームを拡張する手続きがある.
(define (extend-if-consistent var dat frame)
(let ((binding (binding-in-frame var frame)))
(if binding
(pattern-match (binding-value binding) dat frame)
(extend var dat frame))))
フレームに変数の束縛がなければ, 変数とデータとの束縛を追加する. そうでなければ,
このフレームで, フレームでの変数の値にデータをマッチする. 格納されていた値が定数だけで出来ているなら, それはextend-if-consistentを使ったパターンマッチで格納された筈であり, マッチは単に格納されている値と, 新しい値が同じかどうかテストするだけである. そうであれば, 修正せずにフレームを返す; そうでなければ,
失敗の表示を返す. しかし, 格納されている値は, ユニフィケーションで格納されたなら(4.4.4.4節参照)パターン変数を持っているかも知れない. 格納されたパターンが新しいデータに, 再帰的にマッチすると, このパターンの変数の束縛を追加したり,
チェックしたりする. 例えば?xが(f ?y)に束縛され, ?yは未束縛というフレームがあるとし, ?xを(f b)に束縛してこのフレームを拡張したいとする. ?xを探し, それが(f ?y)に束縛されているのを知る.
そこで(f ?y)
はこのフレームで提案されている新しい値(f b)とマッチさせることになる. 最終的にはこのマッチは, フレームを?yのbへの束縛を追加することで拡張する. ?xは(f ?y)に束縛したままである. 格納されている束縛を修正することはない. またある変数に一つを超える束縛を格納することもない.
extend-if-consistentが束縛を操作するのに使う手続きは, 4.4.4.8節で定義する.
readがドットを見つけると, 次の項目をリストの次の要素(つまりcdrがリストの残りであるようなconsのcar) にするのではなく, 次の項目をリスト構造のcdrにする. 例えばパターン(computer ?type)に対してreadが作るリスト構造は, 式(cons 'computer (cons 'type '()))を評価して構成し, (computer . ?type)は, 式(cons 'computer '?type)を評価して構成する.
このようにpattern-matchは, データリストのcarとcdrとドットを持つパターンを再帰的に比較し, 最後にはドットの後の変数(パターンのcdr)を, データの部分リストに対してマッチさせ, 変数をそのリストに束縛する. 例えばパターン(computer . ?type)の(computer~programmer~trainee)に対するマッチは,
?typeをリスト(programmer
trainee)にマッチさせる.
(define (apply-rules pattern frame)
(stream-flatmap (lambda (rule)
(apply-a-rule rule pattern frame))
(fetch-rules pattern frame)))
apply-a-ruleは4.4.2節で述べた方法を使って規則を作用させる. まず規則の結論とフレームのパターンをユニファイして引数のフレームを増やす. これに成功すると, この新しいフレームの中で規則の本体を評価する.
しかしこれらの前に, プログラムは規則の中の変数をすべて一意的な名前に置き換える. その理由は異る規則の作用で, 変数が互いに混乱するのを避けるためである. 例えば二つの規則が共に?xという名の変数を使っていれば, 作用の度にそれぞれが?xに対する束縛を追加するかも知れない. 二つの?xは互いに関係なく, 二つの束縛が矛盾なくあるべきだと変に考えてはいけない. 変数の名前替えよりもっと賢明な環境構造も考案出来よう; しかしここで選んだ名前替えの解決法は, 最も効率的ではないにしろ, 最も直截的である(問題4.79参照). apply-a-rule手続きは次の通り:
(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))))))
規則の部分を取り出す選択子rule-bodyとconclusionは4.4.4.7節で定義する.
一意的な変数名を作るには(整数のような)一意名を規則の作用ごとに対応づけ, この一意名を元々の変数名と組み合せる. 例えば, 規則の作用の一意名が7なら, その規則の各?xを?x-7に変え, 規則の各?yを?y-7に変える. (make-new- variableとnew-rule-application-idは構文手続きと共に, 4.4.4.7節にある.)
(define (rename-variables-in rule)
(let ((rule-application-id (new-rule-application-id)))
(define (tree-walk exp)
(cond ((var? exp)
(make-new-variable exp rule-application-id))
((pair? exp)
(cons (tree-walk (car exp))
(tree-walk (cdr exp))))
(else exp)))
(tree-walk rule)))
ユニフィケーションのアルゴリズムは, 入力として二つのパターンとフレームをとり, 拡張されたフレームか記号failedを返す手続きとして実装する. ユニファイアは, 対称的である---変数はマッチのどちら側にも許される---ことを除き, パターンマッチャに似ている. unify-matchは基本的には(次の「***」で示す)マッチの右側のオブジェクトが変数である場合を扱う余分なコードを除き, pattern-matchと同じである.
(define (unify-match p1 p2 frame)
(cond ((eq? frame 'failed) 'failed)
((equal? p1 p2) frame)
((var? p1) (extend-if-possible p1 p2 frame))
((var? p2) (extend-if-possible p2 p1 frame)) ; ***
((and (pair? p1) (pair? p2))
(unify-match (cdr p1)
(cdr p2)
(unify-match (car p1)
(car p2)
frame)))
(else 'failed)))
ユニフィケーションでは, 一方向性パターンマッチと同様に, 既存の束縛と矛盾しない時だけフレームの拡張提案を受け入れたい. ユニフィケーションで使う手続きextend-if-possibleは, 次のプログラムの「***」で印された二つの特別なチェックを除き, パターンマッチで使うextend-if-consistentと同じである. 第一の場合, マッチしようとしている変数が未束縛だが, マッチさせようとしている値自身がまた(異った)変数であるなら, その値が束縛されているか見るチェックが必要であり, そうであれば, その値とマッチさせる. マッチさせる両者が未束縛なら, どちらかを他方へ束縛する.
第二のチェックは変数を, その変数を含んでいるパターンと束縛する試みを扱う. こういう状況は変数が両方のパターンで繰り返される時に起きる. 例えば?xと?yが共に未束縛のフレームで, 二つのパターン(?x ?x)と(?y 〈?y を含む式〉)をユニファイすることを考えよう. まず?xが?yとマッチし, ?xを?yに束縛する. 次に同じ?xが?yを含む式をマッチされる. ?xは既に?yと束縛しているので, ?yがこの式をマッチすることになる. ユニファイアをパターン変数と, パターンを同じにする値の組を見つけることと考えるなら, これらのパターンは?yを?yを含む式と等価になる?yを見つける命令を意味する. しかしこの式を解く一般的な方法はない. そこでこういう束縛は拒否する; この場合は述語depends-on?が認識する.80 他方変数を自身に束縛するのは拒否したくない. 例えば(?x ?x)と(?y ?y)のユニファイを考えよう. ?xを?yに束縛する二回目の試みは(?xについて格納された値の)?yを(?xの新しい値の)?yに対してマッチしようとする. これはunify-matchのequal?節が面倒をみている.
(define (extend-if-possible var val frame)
(let ((binding (binding-in-frame var frame)))
(cond (binding
(unify-match
(binding-value binding) val frame))
((var? val) ; ***
(let ((binding (binding-in-frame val frame)))
(if binding
(unify-match
var (binding-value binding) frame)
(extend var val frame))))
((depends-on? val var frame) ; ***
'failed)
(else (extend var val frame)))))
depends-on?はパターン変数の値として提案された式が, その変数に依存しているかどうかテストする述語である. これは現在のフレームと相対的になさなければならない. 式はすでに, テスト中の変数に依存した値を持っている変数の出現を持っているかも知れないからである. depends-on?の構造は, 単純な再帰的木の探索で, そこで必要な時に変数の値を置き換える.
(define (depends-on? exp var frame)
(define (tree-walk e)
(cond ((var? e)
(if (equal? var e)
true
(let ((b (binding-in-frame e frame)))
(if b
(tree-walk (binding-value b))
false))))
((pair? e)
(or (tree-walk (car e))
(tree-walk (cdr e))))
(else false)))
(tree-walk exp))
(define THE-ASSERTIONS the-empty-stream)
(define (fetch-assertions pattern frame)
(if (use-index? pattern)
(get-indexed-assertions pattern)
(get-all-assertions)))
(define (get-all-assertions) THE-ASSERTIONS)
(define (get-indexed-assertions pattern)
(get-stream (index-key-of pattern) 'assertion-stream))
get-streamは表の中からストリームを探し出し, 何も格納してなければ空ストリームを返す.
(define (get-stream key1 key2)
(let ((s (get key1 key2)))
(if s s the-empty-stream)))
規則も, 規則の結論のcarを使って同様に格納する. しかし規則の結論は任意のパターンなので, 表明とはパターンが含める点で違う. carが定数の記号であるパターンは, その結論が同じcarを持つ規則だけでなく, 結論の変数で始る規則ともマッチ出来る. 従ってcarが定数の記号のパターンとマッチするかも知れない規則を取り出す時は, その結論がパターンと同じcarを持つものと, その結論が変数から始るすべての規則を取り出す. この目的のため, 結論が変数で始る規則のすべてを, 記号?で添字した表の別のストリームに格納する.
(define THE-RULES the-empty-stream)
(define (fetch-rules pattern frame)
(if (use-index? pattern)
(get-indexed-rules pattern)
(get-all-rules)))
(define (get-all-rules) THE-RULES)
(define (get-indexed-rules pattern)
(stream-append
(get-stream (index-key-of pattern) 'rule-stream)
(get-stream '? 'rule-stream)))
add-rule-or-assertion!はquery-driver-loopが表明と規則をデータベースに追加するのに使う. 各項目は, 適切であれば, その添字のところに格納される. またデータベースのすべての表明か規則のストリームに格納される.
(define (add-rule-or-assertion! assertion)
(if (rule? assertion)
(add-rule! assertion)
(add-assertion! assertion)))
(define (add-assertion! assertion)
(store-assertion-in-index assertion)
(let ((old-assertions THE-ASSERTIONS))
(set! THE-ASSERTIONS
(cons-stream assertion old-assertions))
'ok))
(define (add-rule! rule)
(store-rule-in-index rule)
(let ((old-rules THE-RULES))
(set! THE-RULES (cons-stream rule old-rules))
'ok))
表明や規則を実際に格納するには, それが添字づけ出来るかチェックする. そうであれば, 適切なストリームに格納する.
(define (store-assertion-in-index assertion)
(if (indexable? assertion)
(let ((key (index-key-of assertion)))
(let ((current-assertion-stream
(get-stream key 'assertion-stream)))
(put key
'assertion-stream
(cons-stream assertion
current-assertion-stream))))))
(define (store-rule-in-index rule)
(let ((pattern (conclusion rule)))
(if (indexable? pattern)
(let ((key (index-key-of pattern)))
(let ((current-rule-stream
(get-stream key 'rule-stream)))
(put key
'rule-stream
(cons-stream rule
current-rule-stream)))))))
次の手続きは, データベースの添字の使い方を定義する. パターン(表明か規則の結論)は, それが変数か定数の記号で始れば, 表に格納される.
(define (indexable? pat)
(or (constant-symbol? (car pat))
(var? (car pat))))
パターンが表に格納されるキーは, (変数の場合の)?か先頭の定数の記号である.
(define (index-key-of pat)
(let ((key (car pat)))
(if (var? key) '? key)))
パターンが定数の記号で始れば, 添字をパターンとマッチするかも知れない項目を検索するのに使う.
(define (use-index? pat) (constant-symbol? (car pat)))
(define (add-assertion! assertion)
(store-assertion-in-index assertion)
(set! THE-ASSERTIONS
(cons-stream assertion THE-ASSERTIONS))
'ok)
stream-append-delayedとinterleave-delayedは, (3.5.4節のintegral手続きのように)遅延引数をとることを除き, stream-appendとinterleave[0](3.5.3節)と殆んど同じである. これはループを遅れさせる時がある(問題4.71参照).
(define (stream-append-delayed s1 delayed-s2)
(if (stream-null? s1)
(force delayed-s2)
(cons-stream
(stream-car s1)
(stream-append-delayed (stream-cdr s1) delayed-s2))))
(define (interleave-delayed s1 delayed-s2)
(if (stream-null? s1)
(force delayed-s2)
(cons-stream
(stream-car s1)
(interleave-delayed (force delayed-s2)
(delay (stream-cdr s1))))))
手続きをフレームのストリームにマップし, 結果のフレームのストリームを組み合せるのに, 質問評価器が終始使うstream-flatmapは, 2.2.3節で通常のリストに対して説明したflatmap手続きを, ストリームに変えたものである. しかし通常のflatmapとは違い, 単に連接するのではなく, 差し込んだプロセスによりストリームをを使って蓄積する(問題4.72および4.73参照).
(define (stream-flatmap proc s)
(flatten-stream (stream-map proc s)))
(define (flatten-stream stream)
(if (stream-null? stream)
the-empty-stream
(interleave-delayed
(stream-car stream)
(delay (flatten-stream (stream-cdr stream))))))
評価器はまた, 次の単純な手続きを使い, 単一要素からなるストリームを生成する:
(define (singleton-stream x) (cons-stream x the-empty-stream))
(define (type exp)
(if (pair? exp)
(car exp)
(error "Unknown expression TYPE" exp)))
(define (contents exp)
(if (pair? exp)
(cdr exp)
(error "Unknown expression CONTENTS" exp)))
query-driver-loop(4.4.4.1節)の使う, 次の手続きは, 規則や表明は(assert! 〈rule-or-assertion〉)の形の式でデータベースに追加されることを規定する:
(define (assertion-to-be-added? exp) (eq? (type exp) 'assert!)) (define (add-assertion-body exp) (car (contents exp)))
次にあるのはand, or, notおよびlisp-valueの特殊形式(4.4.4.2節)の構文定義である:
(define (empty-conjunction? exps) (null? exps)) (define (first-conjunct exps) (car exps)) (define (rest-conjuncts exps) (cdr exps)) (define (empty-disjunction? exps) (null? exps)) (define (first-disjunct exps) (car exps)) (define (rest-disjuncts exps) (cdr exps)) (define (negated-query exps) (car exps)) (define (predicate exps) (car exps)) (define (args exps) (cdr exps))
次の三つの手続きは規則の構文を定義する:
(define (rule? statement)
(tagged-list? statement 'rule))
(define (conclusion rule) (cadr rule))
(define (rule-body rule)
(if (null? (cddr rule))
'(always-true)
(caddr rule)))
query-driver-loop(4.4.4.1節)は式の?symbolの形を持つパターン変数を, 内部形式(? symbol)に変換するためにquery-syntax-processを呼び出す. つまり(job ?x ?y)のようなパターンは, 実際はシステム内部では(job (?x) (? y))と表現されている. システムは式がパターン変数かどうかを見るのに, 記号から文字を取り出す必要なしに, 式のcarの記号?を調べることでチェック出来るから, 質問処理の効率は高まる. 構文変換は次の手続きで実行される.81
(define (query-syntax-process exp)
(map-over-symbols expand-question-mark exp))
(define (map-over-symbols proc exp)
(cond ((pair? exp)
(cons (map-over-symbols proc (car exp))
(map-over-symbols proc (cdr exp))))
((symbol? exp) (proc exp))
(else exp)))
(define (expand-question-mark symbol)
(let ((chars (symbol->string symbol)))
(if (string=? (substring chars 0 1) "?")
(list '?
(string->symbol
(substring chars 1 (string-length chars))))
symbol)))
変数がひと度このように変換されると, パターンの変数は?で始るリストになり, 定数の記号(これはデータベースの添字づけで認識しなければならない. 4.4.4.5節)は単に記号である.
(define (var? exp) (tagged-list? exp '?)) (define (constant-symbol? exp) (symbol? exp))
一意的な変数は, 次の手続きを使い, 規則の作用の時(4.4.4.4節)に構成される. 規則の作用の時の一意名は, 規則の作用の度に増える整数である.
(define rule-counter 0) (define (new-rule-application-id) (set! rule-counter (+ 1 rule-counter)) rule-counter) (define (make-new-variable var rule-application-id) (cons '? (cons rule-application-id (cdr var))))
query-driver-loopが答を印字するのに, 質問を具体化する時
(define (contract-question-mark variable)
(string->symbol
(string-append "?"
(if (number? (cadr variable))
(string-append (symbol->string (caddr variable))
"-"
(number->string (cadr variable)))
(symbol->string (cadr variable))))))
を使い, 未束縛変数を印字のための正しい形に変換し戻す. (define (make-binding variable value) (cons variable value)) (define (binding-variable binding) (car binding)) (define (binding-value binding) (cdr binding)) (define (binding-in-frame variable frame) (assoc variable frame)) (define (extend variable value frame) (cons (make-binding variable value) frame))
(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))))
より単純な定義だと, 望ましくない振舞いになる質問の例が書けるか.
(define (flatten-stream stream)
(if (stream-null? stream)
the-empty-stream
(interleave
(stream-car stream)
(flatten-stream (stream-cdr stream)))))
(define (simple-stream-flatmap proc s)
(simple-flatten (stream-map proc s)))
(define (simple-flatten stream)
(stream-map 〈??〉
(stream-filter 〈??〉 stream)))
b. このように変更すると, 質問システムの振舞いは変るか.
(unique (job ?x (computer wizard)))は, Benは唯一人の計算機達人[computer wizard]なので, 一項目ストリーム
(unique (job (Bitdiddle Ben) (computer wizard)))を印字する. また
(unique (job ?x (computer programmer)))は, 一人を超える計算機プログラマがいるので, 空ストリームを印字する. 更に
(and (job ?x ?j) (unique (job ?anyone ?j)))は, 一人だけが担当している仕事すべての担当者をリストする.
uniqueの実装には二つの部分がある. 第一はこの特殊形式を扱う手続きを書くこと, 第二はqevalにその手続きに振り分けさせることである. qevalは振分けをデータ主導で行うので第二の部分は容易である. この手続きをuniquely-assertedと呼ぶなら, なすべきことは
(put 'unique 'qeval uniquely-asserted)で, そうするとqevalはそのtype(car)が記号unique のすべての質問をこの手続きに振り分ける.
本当の問題は, 手続きuniquely-assertedを書くことである. これは入力としてunique質問のcontents (cdr)をフレームのストリームと共にとる. ストリームの各フレームについて, qevalを使い, 与えられた質問を満足するフレームへのすべての拡張ストリームを見つける. そこの唯一個の項目を持つものでないストリームは除去する. 残りのストリームは戻され, unique質問の結果である, 一つの大きなストリームに蓄積する. これはnot特殊形式の実装に類似している.
この実装を, 唯一人を監督する人すべてをリストする質問を形成してテストせよ.
問題 4.76
質問の直列組合せ(図4.5)としてのわれわれのand実装は美しいが, andの第二の質問の処理に, 第一の質問で作られた各フレームにつき, データベースを走査しなければならないので, これは非効率である. データベースにN個の要素があり, 代表的な質問はNに比例した数(例えばN/k)の出力フレームを作るとすれば, 第一の質問で作られたフレームにつき, データベースの操作はN2/k個のパターンマッチの呼出しを必要とするであろう. 別の解決法は, andの二つの節を別々に処理し, 出力フレームの矛盾しないすべての対を探すことである. 各質問がN/kの出力フレームを作り出すから, N2/k2回の無矛盾性のチェックを行う必要がある. ---
現在の方法に必要なマッチ数より, k倍少ない.
この戦略を使うandの実装を考案せよ. 入力として二つのフレームをとり, フレームの束縛が矛盾しないかチェックし, そうであれば束縛の二つの集合を混ぜ合せたフレームを作る手続きを実装しなければならない. この演算は, ユニフィケーションに似ている.
問題 4.77
4.4.3節で, notとlisp-valueは, フィルタ演算を未束縛の変数を持つフレームに作用させると, 質問言語に「悪い」答を出させることを見た. この欠点を改善する方法を考案せよ. 一つの考え方は, フィルタリングを, フレームに演算が出来るように十分な変数が束縛された時に実行されるよう, 「約束」を連接し, 「遅延した」方法で実行することである. フィルタリングの実行を, すべての他の演算が実行されるまで待つことが出来る. しかし効率の点からは, 途中に生成されるフレームの数を少くするよう, フィルタリングを出来るだけ早く実行したい.
問題 4.78
質問言語をストリームプロセスとしてではなく, 4.3節の評価器を使って実装する, 非決定性プログラムとして再設計せよ. この解決法では, 各質問は(すべての答のストリームではなく), 単一の答を出し, 利用者は次の答を知るにはtry-againと入力する.
この節で構築した機構の多くが, 非決定性探索とバックトラッキングに取り込まれることが分るであろう. しかしまた, 新しい質問言語は, ここで実装したものとは, 振舞いが微妙に違うことも分るであろう. この違いを示す例を見つけることは出来ないか.
問題 4.79
4.1節でLispの評価器を実装した時, 手続きのパラメタの間で名前の衝突を避けるための局所的環境の使い方を見た. 例えば
(define (square x) (* x x)) (define (sum-of-squares x y) (+ (square x) (square y))) (sum-of-squares 3 4)を評価する時, それぞれの手続きの本体を, 局所変数の束縛を含むように特別に構成した環境で評価するから, squareのxとsum-of-squaresのxには衝突はない. 質問システムでは, 規則を作用させる時, 名前の衝突を避けるのに, 異る戦略を用いた. 規則を作用させる度, 一意であることを保証する新しい名前で変数を名前替えする. Lisp評価器でも, 同様な戦略は, 局所的環境を不要とし, 手続き本体の変数を, 手続きを作用させる度に, 単に名前を替えることになる.
質問言語で, 名前替えではなく, 環境を使う規則作用の方法を実装せよ. その環境構造にブロック構造の手続きに似た規則のような, 大きいシステムを扱う質問言語の構成を作り出すことが出来るか検討せよ. このいくつかを, 問題解決の方法として, 文脈の中で推論する問題(例えば「Pが真と思うなら, A and Bが推論出来るであろう」)に結びつけることが出来るか. (この問題は未解決である. 優れた解決は学位論文の価値があろう.)
80
一般的に, ?yを?yを含む式とユニファイするには, 式?y = 〈?y〉を含む式の
不動点を見つけることを要求する. 解と思える式を構文的に形成出来る時もある. 例えば?y = (f ?y)は不動点(f (f (f ...)))を持つように見える. これは式(f ?y)から始め, ?yに繰り返し(f ?y)
を代入して作ることが出来る. 困ったことにこういう式がいつでも意味ある不動点を持つわけではない. ここで生じた問題は, 数学で
無限級数を扱う問題と似ている. 例えば2
がy = 1 + y/2の解であることを知っている. 式1 + y/2から始め, yに繰り返し1
+ y/2を代入すると
2 = y = 1 + y/2 = 1 + (1 + y/2)/2 = 1 + 1/2 + 1/4 = ...
になり, これは
2 = 1 + 1/2 + 1/4 + 1/8 + ...
となる. しかし -1が式y = 1 + 2yの解だと見て同じ操作をしても
-1 = y = 1 + 2y = 1 + 2(1 + 2y) = 1 + 2 + 4y = ...
となり
-1 = 1 + 2 + 4 + 8 + ...
となる. これらの式を導くのに使った形式的操作は同じだが, 第一の結果は無限級数の正当な関係式であり, 第二の方はそうではない. 同様にユニフィケーションの結果でも,
任意に構文的に構成された式を考えるとエラーになるかも知れない.
81
殆んどのLispシステムでは, 利用者は,
読込みマクロ文字(reader
macro character)を定義し, 通常のread手続きを修正し, このような変換が出来るようになっている. クォート式は既にこのように扱われている: 読込み手続きは評価器が見る前に, 'expressionを(quote expression)に自動的に変換する.
われわれは?expressionが同様にして(? expression)に変換されるように出来る; しかしはっきりさせるため, ここでは変換手続きを積極的に組み入れた.
expand-question-markとcontract-question-markは, 名前にstring
のついている手続きをいくつか使っている. これらはSchemeの基本手続きである.