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 4.4.2 質問システム - nakayama-blog

@uents blog

Code wins arguments.

SICP 読書ノート#68 - 4.4.4 質問システムの実装(2) (pp.278-292)

REPL

データベース

パーサー

クエリの評価

単純質問

インスタンス化

andクエリ

orクエリ

フィルタ

規則とユニフィケーション

参考リンク