プログラミング再入門

プログラミングをもう一度ちゃんと勉強する読書ノート

SICP 4.4.2 How the Query System Works

LISP Scheme

ノート

明らかにquery evaluatorは何らかの探索を行う。
一つの方法は非決定論的プログラミングでambを使った実装。もう一つはストリームを使う実装。（ここではストリームで実装する）
query systemは大きく分けて二つの操作からなる：パターンマッチと単一化。

Pattern matching

パターンマッチャーへの入力は、パターン、データ、パターン変数の拘束を持つフレーム。パターンがマッチした場合には新たに変数を拘束したフレームを返す。
simple queryはこれだけで実現出来る。

Streams of frames

可能なパターンをストリームとして入力し、データとマッチしたものだけを出力のストリームに流す。マッチするものだけをフィルターする感じ。
出力のフレームは入力のフレームの拡張。複数マッチする場合は共通の入力フレームにそれぞれの拡張が付いたフレームが出力のストリームに流れる。

なるほど。ambの場合は答えが出る度にtry-againして別のパターンを試す感じか。

Compound queries

andを実現するには二つのqueryを直列にする。
orを実現するには二つのqueryの出力ストリームをマージする。
notは入力ストリームのフレームのうちマッチしなかったものを出力ストリームに流す。
lisp-valueはマッチャートは異なるが同様にフィルターとして働く。

Unification

ルールの結論部はアサートと似ているが、パターン変数を含むので更に一般化した探索が必要。これが単一化。ここではパターンもデータもパターン変数を含む。

ユニファイヤは二つのパターンを入力とし、二つのパターンが同じになる様な変数の拘束が可能か試す。
可能な拘束が見つかったらそのフレームを返す。

Applying rules
  1. まず問い合わせにマッチするアサートを探す
  2. 次に問い合わせとマッチするルールを探す
  3. ルールが見つかったらフレームを返し、今度はそのフレーム内でruleの本体の評価を続ける

このプロセスはLispのevalとapplyのプロセスと似ている。

Simple queries

ルールも考慮すると、シンプルなクエリの結果はパターンマッチの結果とルールを適用した結果をマージしたものになる。

The query evaluator and the driver loop

query evaluatorにはevalに相当するqevalがあり、Lisp同様幾つかのスペシャルフォームがある。
問い合わせではないassert!はスペシャルコマンド。

4.4.3 Is Logic Programming Mathematical Logic?

and、or、notはこれまでの数学的な演算子とは少し意味が違う。
andにぶら下がる条件は本来可換だが、現実には結果は同じであっても効率は条件式の順番によって相当変わる。

論理プログラミングの目的は、問題をwhatとhowの部分に分離する事。
数学的な論理は計算には十分強力だが、手続き的な順序を制御するのには向いていない。
論理プログラミングのプログラムはコンピュータで効率よく計算出来る様に記述しなければならない。
節の順番で計算順序を制御する。

query languageは手続き的に解釈出来る数学的論理と解釈出来る。

Infinet loops

簡単な例としては、一つの事実がマッチしてもシステムは他にもマッチするパターンが無いか探してしまい、また最初のルールがマッチしてしまう様な場合無限ループに陥る。

Problems with not

数学的論理としては同じに見える二つのクエリは結果が異なる。

;;; Query input:
(and (supervisor ?x ?y)
     (not (job ?x (computer programmer))))

;;; Query results:
(and (supervisor (Aull DeWitt) (Warbucks Oliver)) (not (job (Aull DeWitt) (computer programmer))))
(and (supervisor (Cratchet Robert) (Scrooge Eben)) (not (job (Cratchet Robert) (computer programmer))))
(and (supervisor (Scrooge Eben) (Warbucks Oliver)) (not (job (Scrooge Eben) (computer programmer))))
(and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (not (job (Bitdiddle Ben) (computer programmer))))
(and (supervisor (Reasoner Louis) (Hacker Alyssa P)) (not (job (Reasoner Louis) (computer programmer))))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer))))
;;; Query input:
(and (not (job ?x (computer programmer)))
     (supervisor ?x ?y))

;;; Query results:
;;; Query input:

最初のクエリはsupervisorのリストを挙げて、次に?xのjobがcomputer programmerではない人に絞っている。
notはフィルタとして働くので最初に入力としてリストが挙っていないといけない。入力が無ければnotは何も出力しないので二番目のクエリは空を返す事になる。

;;; Query results:
;;; Query input:
(job ?x (computer programmer))

;;; Query results:
(job (Fect Cy D) (computer programmer))
(job (Hacker Alyssa P) (computer programmer))
;;; Query input:
(not (job ?x (computer programmer)))

;;; Query results:
;;; Query input:

notが拘束されていない変数を含むフレームに適用されると期待通りの結果は得られない。lisp-valueもフィルタなので同じことが起きる。
論理演算ではnot PとはPはtrueではない事。クエリシステムでのnot PはPは推定出来ない事を意味している。
ここでのnotは限られた情報の中での補集合の様に働く。

Exercise 4.64

元の定義。

(rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (supervisor ?staff-person ?middle-manager)
               (outranked-by ?middle-manager ?boss))))

実行結果。

;;; Query input:
(assert! (rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (supervisor ?staff-person ?middle-manager)
               (outranked-by ?middle-manager ?boss)))))

Assertion added to data base.
;;; Query input:
(outranked-by (Bitdiddle Ben) ?who)

;;; Query results:
(outranked-by (Bitdiddle Ben) (Warbucks Oliver))

書き換えられた定義

(rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (outranked-by ?middle-manager ?boss)
               (supervisor ?staff-person ?middle-manager))))

最後の二つの条件が入れ替わっている。
実行すると

;;; Query input:
(assert! (rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (outranked-by ?middle-manager ?boss)
               (supervisor ?staff-person ?middle-manager)))))

Assertion added to data base.
;;; Query input:
(outranked-by (Bitdiddle Ben) ?who)

;;; Query results:
(outranked-by (Bitdiddle Ben) (Warbucks Oliver))

と言ったまま、次の入力待ちにならず返って来ない。
?middle-managerは拘束されずにoutranked-byを再帰探索（？）してしまうので無限再帰に陥る。
最上位の結合子がorなので、両方の探索を必ず行い、andの最初の条件なのでoutranked-byが呼ばれると必ず再帰する。

Exercise 4.65

実際にそうなるか確かめてみる。

;;; Query input:
(assert! (rule (wheel ?person)
      (and (supervisor ?middle-manager ?person)
           (supervisor ?x ?middle-manager))))

Assertion added to data base.
;;; Query input:
(wheel ?who)

;;; Query results:
(wheel (Warbucks Oliver))
(wheel (Warbucks Oliver))
(wheel (Bitdiddle Ben))
(wheel (Warbucks Oliver))
(wheel (Warbucks Oliver))
;;; Query input:

確かに。wheelの条件を分解してみる

;;; Query input:
(supervisor ?middle-manager ?person)

;;; Query results:
(supervisor (Aull DeWitt) (Warbucks Oliver))
(supervisor (Cratchet Robert) (Scrooge Eben))
(supervisor (Scrooge Eben) (Warbucks Oliver))
(supervisor (Bitdiddle Ben) (Warbucks Oliver))
(supervisor (Reasoner Louis) (Hacker Alyssa P))
(supervisor (Tweakit Lem E) (Bitdiddle Ben))
(supervisor (Fect Cy D) (Bitdiddle Ben))
(supervisor (Hacker Alyssa P) (Bitdiddle Ben))
;;; Query input:

Oliver Warbucksは3人のsupervisor。それぞれの部下を調べると。

;;; Query input:
(supervisor ?x (Aull DeWitt))

;;; Query results:
;;; Query input:
(supervisor ?x (Scrooge Eben))

;;; Query results:
(supervisor (Cratchet Robert) (Scrooge Eben))
;;; Query input:
(supervisor ?x (Bitdiddle Ben))

;;; Query results:
(supervisor (Tweakit Lem E) (Bitdiddle Ben))
(supervisor (Fect Cy D) (Bitdiddle Ben))
(supervisor (Hacker Alyssa P) (Bitdiddle Ben))
;;; Query input:

と合計で4人の孫部下を持っているので、孫部下が見つかる度に表示される。

Exercise 4.66
;;; Query input:
(job ?x (computer programmer))

;;; Query results:
(job (Fect Cy D) (computer programmer))
(job (Hacker Alyssa P) (computer programmer))
;;; Query input:

このクエリの答えには重複が無いので良いが、一般化した時にの部分は重複した答えを返す可能性があるので、重複を取り除く必要がある。

Exercise 4.67

無限ループに関して分かっている事は

  • simple queryでは蓄積されている事実に付いて一通り探索するだけなので、無限ループになる事は無い。
  • ルールがマッチした場合に、もう一度最初から探索が始まるのでループに陥る可能性がある。
  • 同じルールがマッチしたとしても、論理変数の拘束状態が変わっていれば無限ループではない筈。

とすると、ルールを適用しようとする時に過去に探索したパターン（論理変数の拘束も含む）と同じかどうかが分かれば良い。

実装の詳細は次節だが、apply-a-ruleの所にこの仕組みを組み込めば良さそう。apply-a-ruleに入って来るquery-patternを見てみると

(married Mickey (? who))
(married (? 1 y) (? 1 x))
(married (? 2 y) (? 2 x))
(married (? 3 y) (? 3 x))
(married (? 4 y) (? 4 x))

こんな感じ。拘束された値を展開させてみる。

(define (apply-a-rule rule query-pattern query-frame)
  (let ((clean-rule (rename-variables-in rule))
        (intermediate-pattern (instantiate query-pattern query-frame (lambda (v f) v))))
...

このintermediate-patternを見てみると

(married Mickey (? who))
(married (? 1 y) Mickey)
(married Mickey (? 2 x))
(married (? 3 y) Mickey)
(married Mickey (? 4 x))

と言う事は(married Mickey (? 2 x))が来た時点で(married Mickey (? who))と同じである事が検出出来れば良い。
二つ関数を作る。same-pattern?は二つのパターンが同じかどうか、(? ...)は中身が何であろうが同じとみなす。contain-same-pattern?はパターンのリストpsがパターンpを含んでいるか否か。

(define (same-pattern? p1 p2)
  (cond ((and (null? p1) (null? p2)) true)
        ((or (null? p1) (null? p2)) false)
        ((or (and (pair? (car p1)) (pair? (car p2)) (eq? (caar p1) '?) (eq? (caar p2) '?))
             (eq? (car p1) (car p2)))
         (same-pattern? (cdr p1) (cdr p2)))
        (else false)))

(define (contain-same-pattern? ps p)
  (cond ((or (null? p) (null? ps)) false)
        ((same-pattern? (car ps) p) true)
        (else (contain-same-pattern? (cdr ps) p))))

動作確認

> (same-pattern? '(married Mickey (? who)) '(married Mickey (? 2 x)))
#t
> (same-pattern? '(married Mickey (? who)) '(married (? 1 y) Mickey))
#f
> (contain-same-pattern? '((married (? 147 y) Mickey a) (married (? 147 y) Minnie) (married (? 147 y) Mickey)) '(married (? 145 y) Mickey))
#t
> (contain-same-pattern? '((married (? 147 y) Mickey a) (married (? 147 y) Minnie)) '(married (? 145 y) Mickey))
#f
>

空リストから始めてapply-a-ruleでパターンを蓄積させて行く。同じパターンを検出したらunificationに失敗した時と同じくthe-empty-streamを返す。

(define (query-driver-loop)
（中略）
             (qeval q (singleton-stream '()) '())))
           (query-driver-loop)))))

(define (apply-a-rule rule query-pattern query-frame history)
  (let ((clean-rule (rename-variables-in rule))
        (intermediate-pattern (instantiate query-pattern query-frame (lambda (v f) v))))
    (if (contain-same-pattern? history intermediate-pattern)
        the-empty-stream
        (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) (cons intermediate-pattern history)))))))

この二つの手続きの間に入る関数全てにhistoryをたらい回しするのがやや面倒だが組み込むと：

(define (qeval query frame-stream history)
  (let ((qproc (get (type query) 'qeval)))
    (if qproc
        (qproc (contents query) frame-stream history)
        (simple-query query frame-stream history))))

(define (simple-query query-pattern frame-stream history)
  (stream-flatmap
   (lambda (frame)
     (stream-append-delayed
      (find-assertions query-pattern frame)
      (delay (apply-rules query-pattern frame history))))
   frame-stream))

(define (conjoin conjuncts frame-stream history)
  (if (empty-conjunction? conjuncts)
      frame-stream
      (conjoin (rest-conjuncts conjuncts)
               (qeval (first-conjunct conjuncts)
                      frame-stream
                      history)
               history)))

(define (disjoin disjuncts frame-stream history)
  (if (empty-disjunction? disjuncts)
      the-empty-stream
      (interleave-delayed
       (qeval (first-disjunct disjuncts) frame-stream history)
       (delay (disjoin (rest-disjuncts disjuncts)
                       frame-stream
                       history)))))

(define (negate operands frame-stream history)
  (stream-flatmap
   (lambda (frame)
     (if (stream-null? (qeval (negated-query operands)
                              (singleton-stream frame)
                              history))
         (singleton-stream frame)
         the-empty-stream))
   frame-stream))

(define (lisp-value call frame-stream history)
  (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))

(define (always-true ignore frame-stream history) frame-stream)

(define (apply-rules pattern frame history)
  (stream-flatmap (lambda (rule)
                    (apply-a-rule rule pattern frame history))
                  (fetch-rules pattern frame)))

では動作確認。MickeyとMinnieの例

;;; Query input:
(assert! (married Minnie Mickey))

Assertion added to data base.
;;; Query input:
(married Mickey ?who)

;;; Query results:
;;; Query input:
(assert! (rule (married ?x ?y)
               (married ?y ?x)))

Assertion added to data base.
;;; Query input:
(married Mickey ?who)

;;; Query results:
(married Mickey Minnie)
;;; Query input:

無限ループに入らずに止まる。
Exercise 4.64のoutranked-byの例
元のルールでは

;;; Query input:
(assert! (rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (supervisor ?staff-person ?middle-manager)
               (outranked-by ?middle-manager ?boss)))))

Assertion added to data base.
;;; Query input:
(outranked-by (Bitdiddle Ben) ?who)

;;; Query results:
(outranked-by (Bitdiddle Ben) (Warbucks Oliver))
;;; Query input:

間違えて書き換えた方の例

;;; Query input:
(assert! (rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (outranked-by ?middle-manager ?boss)
               (supervisor ?staff-person ?middle-manager)))))

Assertion added to data base.
;;; Query input:
(outranked-by (Bitdiddle Ben) ?who)

;;; Query results:
(outranked-by (Bitdiddle Ben) (Warbucks Oliver))
;;; Query input:

無限ループせずにちゃんと同じ答えが返って来る。

Exercise 4.68

普通に単純に考えると

(assert! (rule (reverse (?x) (?x))))
(assert! (rule (reverse (?x . ?y) ?z)
               (and (reverse ?y ?w)
                    (append-to-form ?w (?x) ?z))))

ところが、これだと片方向にしか計算出来ない。

;;; Query input:
(reverse (1 2 3) ?x)

;;; Query results:
(reverse (1 2 3) (3 2 1))
;;; Query input:
(reverse ?x (1 2 3))

;;; Query results:
;;; Query input:

二つの引数を対称に扱おうとして以下の様にすると

(assert! (rule (reverse (?x) (?x))))
(assert! (rule (reverse (?x . ?y) (?a . ?b))
               (or (and (reverse ?y ?w)
                        (append-to-form ?w (?x) (?a . ?b)))
                   (and (reverse ?b ?c)
                        (append-to-form ?c (?a) (?x . ?y))))))

結果

;;; Query input:
(reverse (1 2 3) ?x)

;;; Query results:
(reverse (1 2 3) (3 2 1))
(reverse (1 2 3) (3 2 1))
;;; Query input:
(reverse ?x (1 2 3))

;;; Query results:
(reverse (3 2 1) (1 2 3))
(reverse (3 2 1) (1 2 3))
;;; Query input:

どちら方向も動く事は動くが結果が二つ出てしまう。実はorは対称ではないのでこれ以上はどうにもならないか。
Prologの世界では上手く動いている以下の定義

(assert! (rule (reverse ?x ?y)
               (rev ?x () ?y)))
(assert! (rule (rev () ?x ?x)))
(assert! (rule (rev (?a . ?x) ?y ?z)
               (rev ?x (?a . ?y) ?z)))

は、このquery systemではやはり片方向にしか計算出来ない。

;;; Query input:
(assert! (rule (reverse ?x ?y)
               (rev ?x () ?y)))

Assertion added to data base.
;;; Query input:
(assert! (rule (rev () ?x ?x)))

Assertion added to data base.
;;; Query input:
(assert! (rule (rev (?a . ?x) ?y ?z)
               (rev ?x (?a . ?y) ?z)))

Assertion added to data base.
;;; Query input:
(reverse (1 2 3) ?x)

;;; Query results:
(reverse (1 2 3) (3 2 1))
;;; Query input:
(reverse ?x (1 2 3))

;;; Query results:. . user break
>

答えが２回表示されるけど双方向に答えが出るのが良いか、答えは一つしか表示されないが片方向にしか答えが出せないのが良いか。

Exercise 4.69

親子関係の事実に対して世代を一つ増やす、sonに対してはgrand-sonを作る様なルール。

そもそも

;;; Query input:
(assert! ((great grandson) Adam Irad))
. . store-assersion-in-index: assersion is not indexable
>

indexable?が最初の要素はシンボルか論理変数（?で始まるリスト）である事を要求しているので、この形式は受け付けられない。

;;; Query input:
(assert! (rule ((great . ?rel) ?x ?y)))
. . store-rule-in-index: pattern is not indexable
>

なので取り敢えず、indexable?は先頭がシンボルのリストも許す事にする。

(define (indexable? pat)
  (or (constant-symbol? (car pat))
      (constant-symbol? (caar pat))
      (var? (car pat))))

これで、リストをインデックスにした事実を登録出来て、simple queryが出来る。

;;; Query input:
(assert!  ((great grandson) Adam Irad))

Assertion added to data base.
;;; Query input:
((great grandson) Adam ?who)

;;; Query results:
((great grandson) Adam Irad)
;;; Query input:
((great grandson) ?who Irad)

;;; Query results:
((great grandson) Adam Irad)
;;; Query input:

まずはルールの名前部分のリストが段々減って来る事を想定して、最後がgrandsonだけ残った時のルールを作る。

;;; Query input:
(assert! (rule ((grandson) ?grand-father ?grand-son)
               (grand-son-of ?grand-father ?grand-son)))

Assertion added to data base.
;;; Query input:
((grandson) Adam ?who)

;;; Query results:
((grandson) Adam Enoch)
;;; Query input:
((grandson) ?who Enoch)

;;; Query results:
((grandson) Adam Enoch)
;;; Query input:

一応答えは合っている。
次に、問題の((great . ?rel) ?x ?y)と言うルールを作る。?relの部分はgreatが

;;; Query input:
(assert! (rule ((great . ?rel) ?x ?y)
               (and (son-of ?x ?w)
                    (?rel ?w ?y))))

Assertion added to data base.
;;; Query input:
((great grandson) ?g ?ggs)

;;; Query results:
((great grandson) Adam Irad)
((great grandson) Mehujael Jubal)
((great grandson) Irad Lamech)
((great grandson) Mehujael Jabal)
((great grandson) Enoch Methushael)
((great grandson) Cain Mehujael)
((great grandson) Adam Irad)
;;; Query input:
(?relationship Adam Irad)

;;; Query results:
((great grandson) Adam Irad)
((great great . son) Adam Irad)
((great grandson) Adam Irad)
((great great . son-of) Adam Irad)
((great . grand-son-of) Adam Irad)
;;; Query input:

こんなクエリも出来る。

;;; Query input:
((great . son) Adam ?who)

;;; Query results:
((great . son) Adam Enoch)
;;; Query input:
((great . son-of) Adam ?who)

;;; Query results:
((great . son-of) Adam Enoch)
;;; Query input:

となると、(grandson)を作って意味は良く分からなくなって来る。
ルールの名前にリストを許して、そこに論理変数を入れるとルールそのものも可変になる。