プログラミング再入門

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

SICP 4.4 Logic Programming

LISP Scheme

Nondeterministic Computingで少し雰囲気を感じつつ、ついに論理プログラミングに到達。
第５章はまた毛色が違う話なので、ここが一つの到達点なのかな。

ノート

数学はdeclarative（宣言的）、コンピュータサイエンスはimperative（命令的）。
高級言語になるとどうやって計算するのかのの多くの部分について言語が提供してくれてプログラマは気にしなくて済む。

式ベースの言語では関数の値を表す式が、その値の計算方法にもなっている。この事により、これらの言語ではunidirectional、つまり入力から出力への一方通行の計算方法を基本にしている。

そうではない言語もある。
制約プログラミングがひとつ。非決定論的コンピューティングもひとつ。
論理プログラミングはユニフィケーションによってこれらのアイデアを更に発展させる。

appendの定義は以下の二つのルールをLispに翻訳したものと解釈出来る：

  • 任意のリストyに関して、空リストにyを繋いだものがy。
  • 任意のu、v、y、zに関して、vにyを結合したものをzとした時に、(cons u v)にyを結合したものが(cons u z)

って全然意味が分からないが、x=(cons u v）と考えるとu = (car x) 、v = (cdr x)。
「v and y append form z」はz = (append v y)つまり z = (append (cdr x) y)の事。
「(cons u v) and y append to form (cons u z)」は(append (cons u v) y)即ち(append x y)は(cons u z)即ち(cons (car x) (append (cdr x) y))であると言う事。

論理プログラミングではプログラマは上記二つのルールを各だけで以下の3つの問いの答えを出す事が出来る。

  • (a b)と(c d)のappendは？
  • (a b)にappendしたら(a b c d)となるリストyは？
  • appendしたら(a b c d)となる二つのリストxとyは？
4.4.1 Deductive Information Retrieval

論理プログラミングはデータベースのインターフェースとして優れている。

A sample data base

一つ一つのリストをassertionと呼んでいる。前節の自然言語解釈のパース結果の様に先頭にタグが付いたシンボルのリストっぽい。

Simple queries

やはりサンプルが出て来ると実際に動かしたいので、4.4.4節のコードを使って動かしてみる。
挙動の理解は兎も角4.4.4節のコードを全てコピーする。

3.3.3節のテーブルを使うが、この中でset-cdr!が使われていてこれがRacketには標準から外れている。mpairとか使えば使えない事も無いが色々と厄介な事が付いて来る。なのでハッシュを使って再実装。

#lang racket
(require racket/dict)

(define (make-table)
  (let ((local-table (make-hash)))
    (define (lookup key-1 key-2)
      (let ((subtable (dict-ref local-table key-1 #f)))
        (if subtable
            (dict-ref subtable key-2 #f)
            #f)))
    (define (insert! key-1 key-2 value)
      (let ((subtable (dict-ref local-table key-1 #f)))
        (if subtable
            (dict-set! subtable key-2 value)
            (dict-set! local-table key-1 (let ((h (make-hash)))
                                           (dict-set! h key-2 value)
                                           h)))
      'ok))
    (define (dispatch m)
      (cond ((eq? m 'lookup-proc) lookup)
            ((eq? m 'insert-proc!) insert!)
            (else (error "Unknown operation -- TABLE" m))))
    dispatch))
(define eval-table (make-table))
(define get (eval-table 'lookup-proc))
(define put (eval-table 'insert-proc!))

まぁ一応同じ動きをする筈。

次にストリーム。cons-streamはテキストには提供されていなかったが自前で作ったのを再利用。

(define-syntax cons-stream
  (syntax-rules ()
    ((cons-stream a b)
     (cons a (delay b)))))

stream-null?とthe-empty-streamもテキストには定義は無いが脚注に従って自分で定義。

(define stream-null? null?)
(define the-empty-stream null)

stream-car、stream-cdr、stream-map、stream-for-each、display-stream、display-lineは3.5.1節から、stream-appendを3.5.3節から、tagged-listを4.1.2節から、prompt-for-inputを4.1.4節からコピーする。

user-initial-environmentは定義されていないが、Racketの場合make-base-namespaceで作った名前空間をevalが受け取るので以下の様に定義する。

(define user-initial-environment (make-base-namespace))

また、Racketはelse部がないif構文を許さないのでstore-assertion-in-indexとstore-rule-in-indexを以下の様に変更。

(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))))
      (error "store-assersion-in-index: assersion is not indexable")))

(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))))
        (error "store-rule-in-index: pattern is not indexable"))))

これで評価器は完成。

まず、Sample data baseのアサート達を全部4.4.2の最後に書いてある通り(assert! ...)で登録する。

;;; Query input:
(assert! (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)))

Assertion added to data base.
;;; Query input:

こんな感じ。

では、クエリを実行してみる。

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

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

テキストと表示される順番は違うけど動いた。

クエスチョンマーク＋シンボルをパターン変数とする。

;;; Query input:
(address ?x ?y)

;;; Query results:
(address (Aull DeWitt) (Slumerville (Onion Square) 5))
(address (Cratchet Robert) (Allston (N Harvard Street) 16))
(address (Scrooge Eben) (Weston (Shady Lane) 10))
(address (Warbucks Oliver) (Swellesley (Top Heap Road)))
(address (Reasoner Louis) (Slumerville (Pine Tree Road) 80))
(address (Tweakit Lem E) (Boston (Bay State Road) 22))
(address (Fect Cy D) (Cambridge (Ames Street) 3))
(address (Hacker Alyssa P) (Cambridge (Mass Ave) 78))
(address (Bitdiddle Ben) (Slumerville (Ridge Road) 10))
;;; Query input:

住所の登録は全部で９件。

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

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

自分自身を監督している人は誰もいない。
問い合わせのリストの中に含まれる要素の数も意味を持つ。

;;; Query input:
(job ?x (computer ?type))

;;; Query results:
(job (Tweakit Lem E) (computer technician))
(job (Fect Cy D) (computer programmer))
(job (Hacker Alyssa P) (computer programmer))
(job (Bitdiddle Ben) (computer wizard))
;;; Query input:

可変長のリストにマッチさせるにはLispの可変長引数の様に指定する。

;;; Query input:
(job ?x (computer . ?type))

;;; Query results:
(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))
;;; Query input:
Exercise 4.55
;;; 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:
(job ?x (accounting . ?y))

;;; Query results:
(job (Cratchet Robert) (accounting scrivener))
(job (Scrooge Eben) (accounting chief accountant))
;;; Query input:
(address ?x (Slumerville . ?y))

;;; Query results:
(address (Aull DeWitt) (Slumerville (Onion Square) 5))
(address (Reasoner Louis) (Slumerville (Pine Tree Road) 80))
(address (Bitdiddle Ben) (Slumerville (Ridge Road) 10))
;;; Query input:
Compound queries

andの例。

;;; Query input:
(and (job ?person (computer programmer))
     (address ?person ?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)))
;;; Query input:

orの例。

;;; Query input:
(or (supervisor ?x (Bitdiddle Ben))
    (supervisor ?x (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:

notの例。

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

;;; Query results:
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (not (job (Tweakit Lem E) (computer programmer))))
;;; Query input:

lisp-valueの例。

;;; Query input:
(and (salary ?person ?amount)
     (lisp-value > ?amount 30000))

;;; Query results:
(and (salary (Scrooge Eben) 75000) (lisp-value > 75000 30000))
(and (salary (Warbucks Oliver) 150000) (lisp-value > 150000 30000))
(and (salary (Fect Cy D) 35000) (lisp-value > 35000 30000))
(and (salary (Hacker Alyssa P) 40000) (lisp-value > 40000 30000))
(and (salary (Bitdiddle Ben) 60000) (lisp-value > 60000 30000))
;;; Query input:
Exercise 4.56

a.

;;; Query input:
(and (supervisor ?person (Bitdiddle Ben))
     (address ?pserson ?where))

;;; Query results:
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Aull DeWitt) (Slumerville (Onion Square) 5)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Aull DeWitt) (Slumerville (Onion Square) 5)))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Cratchet Robert) (Allston (N Harvard Street) 16)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Aull DeWitt) (Slumerville (Onion Square) 5)))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Scrooge Eben) (Weston (Shady Lane) 10)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Cratchet Robert) (Allston (N Harvard Street) 16)))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Warbucks Oliver) (Swellesley (Top Heap Road))))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Cratchet Robert) (Allston (N Harvard Street) 16)))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Scrooge Eben) (Weston (Shady Lane) 10)))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Tweakit Lem E) (Boston (Bay State Road) 22)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Scrooge Eben) (Weston (Shady Lane) 10)))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Fect Cy D) (Cambridge (Ames Street) 3)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Warbucks Oliver) (Swellesley (Top Heap Road))))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Warbucks Oliver) (Swellesley (Top Heap Road))))
(and (supervisor (Tweakit Lem E) (Bitdiddle Ben)) (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Reasoner Louis) (Slumerville (Pine Tree Road) 80)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Tweakit Lem E) (Boston (Bay State Road) 22)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Tweakit Lem E) (Boston (Bay State Road) 22)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Fect Cy D) (Cambridge (Ames Street) 3)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Fect Cy D) (Cambridge (Ames Street) 3)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Hacker Alyssa P) (Cambridge (Mass Ave) 78)))
(and (supervisor (Fect Cy D) (Bitdiddle Ben)) (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)))
(and (supervisor (Hacker Alyssa P) (Bitdiddle Ben)) (address (Bitdiddle Ben) (Slumerville (Ridge Road) 10)))
;;; Query input:

b.

;;; Query input:
(and (salary (Bitdiddle Ben) ?Bens-salary)
     (and (salary ?person ?salary)
          (lisp-value > ?Bens-salary ?salary)))

;;; Query results:
(and (salary (Bitdiddle Ben) 60000) (and (salary (Aull DeWitt) 25000) (lisp-value > 60000 25000)))
(and (salary (Bitdiddle Ben) 60000) (and (salary (Cratchet Robert) 18000) (lisp-value > 60000 18000)))
(and (salary (Bitdiddle Ben) 60000) (and (salary (Reasoner Louis) 30000) (lisp-value > 60000 30000)))
(and (salary (Bitdiddle Ben) 60000) (and (salary (Tweakit Lem E) 25000) (lisp-value > 60000 25000)))
(and (salary (Bitdiddle Ben) 60000) (and (salary (Fect Cy D) 35000) (lisp-value > 60000 35000)))
(and (salary (Bitdiddle Ben) 60000) (and (salary (Hacker Alyssa P) 40000) (lisp-value > 60000 40000)))
;;; Query input:

c.

;;; Query input:
(and (supervisor ?person ?supervisor)
     (not (job ?supervisor (computer . ?x))))

;;; Query results:
(and (supervisor (Aull DeWitt) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?x))))
(and (supervisor (Cratchet Robert) (Scrooge Eben)) (not (job (Scrooge Eben) (computer . ?x))))
(and (supervisor (Scrooge Eben) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?x))))
(and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?x))))
;;; Query input:
Rules

手続きの様に問い合わせに名前をつけて抽象化する事が出来る。

;;; Query input:
(assert! (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)))))

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

Assertion added to data base.
;;; Query input:
(lives-near ?x (Bitdiddle Ben))

;;; Query results:
(lives-near (Aull DeWitt) (Bitdiddle Ben))
(lives-near (Reasoner Louis) (Bitdiddle Ben))
;;; Query input:
(and (job ?x (computer programmer))
     (lives-near ?x (Bitdiddle Ben)))

;;; Query results:
;;; Query input:
Exercise 4.57

どうしても癖で、未知数を関数値として該当者を返す様な考え方になってしまい勝ちだが、lives-nearの例を見ると分かる様に未知数はどこにでも置けるので、未知数も含めて引数と言うか変数とする。
条件は

  1. person1のjobをjob1、
  2. person2のjobをjob2とした時に、
  3. job1とjob2が同じか
  4. job2はjob1を兼任出来る（can-do-jobを使う）
  5. かつperson1とperson2は別人
(assert! (rule (same ?x ?x)))
(assert! (rule (replace ?person1 ?person2)
               (and (job ?person1 ?job1)
                    (job ?person2 ?job2)
                    (or (same ?job1 ?job2)
                        (can-do-job ?job2 ?job1))
                    (not (same ?person1 ?person2)))))

a.
この問い合わせは単純。

;;; Query input:
(replace (Fect Cy D) ?x)

;;; Query results:
(replace (Fect Cy D) (Bitdiddle Ben))
(replace (Fect Cy D) (Hacker Alyssa P))
;;; Query input:

b.
person1がperson2の仕事を代われて、しかもperson2の給料の方が高い。

(and (replace ?person1 ?person2)
     (salary ?person1 ?salary1)
     (salary ?person2 ?salary2)
     (lisp-value < ?salary1 ?salary2))

実行結果。

;;; Query input:
(and (replace ?person1 ?person2)
     (salary ?person1 ?salary1)
     (salary ?person2 ?salary2)
     (lisp-value < ?salary1 ?salary2))

;;; Query results:
(and (replace (Reasoner Louis) (Fect Cy D)) (salary (Reasoner Louis) 30000) (salary (Fect Cy D) 35000) (lisp-value < 30000 35000))
(and (replace (Reasoner Louis) (Hacker Alyssa P)) (salary (Reasoner Louis) 30000) (salary (Hacker Alyssa P) 40000) (lisp-value < 30000 40000))
(and (replace (Tweakit Lem E) (Bitdiddle Ben)) (salary (Tweakit Lem E) 25000) (salary (Bitdiddle Ben) 60000) (lisp-value < 25000 60000))
(and (replace (Fect Cy D) (Bitdiddle Ben)) (salary (Fect Cy D) 35000) (salary (Bitdiddle Ben) 60000) (lisp-value < 35000 60000))
(and (replace (Hacker Alyssa P) (Bitdiddle Ben)) (salary (Hacker Alyssa P) 40000) (salary (Bitdiddle Ben) 60000) (lisp-value < 40000 60000))
(and (replace (Fect Cy D) (Hacker Alyssa P)) (salary (Fect Cy D) 35000) (salary (Hacker Alyssa P) 40000) (lisp-value < 35000 40000))
;;; Query input:
Exercise 4.58

条件はほぼそのまま。スペルミスに気をつけないと何も言わずにシカトされる。

(assert! (rule (big-shot ?person ?division)
               (and (supervisor ?person ?supervisor)
                    (job ?person (?division . ?job-p))
                    (job ?supervisor (?division-s . ?job-s))
                    (not (same ?division ?division-s)))))

実行結果。

;;; Query input:
(big-shot ?person ?division)

;;; Query results:
(big-shot (Scrooge Eben) accounting)
(big-shot (Bitdiddle Ben) computer)
;;; Query input:
Exercise 4.59

a.

;;; Query input:
(meeting ?div (Friday ?time))

;;; Query results:
(meeting administration (Friday 1pm))
;;; Query input:

b.

(assert! (rule (meeting-time ?person ?day-and-time)
               (and (job ?person (?division . ?position))
                    (or (meeting ?division ?day-and-time)
                        (meeting whole-company ?day-and-time)))))

実行結果

;;; Query input:
(meeting-time (Hacker Alyssa P) ?time)

;;; Query results:
(meeting-time (Hacker Alyssa P) (Wednesday 3pm))
(meeting-time (Hacker Alyssa P) (Wednesday 4pm))
;;; Query input:

c.
Alyssaは水曜日にしかミーティングを持っておらず分かりにくいので、Aull DeWittで試す。

;;; Query input:
(meeting-time (Hacker Alyssa P) (Wednesday . ?time))

;;; Query results:
(meeting-time (Hacker Alyssa P) (Wednesday 3pm))
(meeting-time (Hacker Alyssa P) (Wednesday 4pm))
;;; Query input:
(meeting-time (Aull DeWitt) (Wednesday . ?time))

;;; Query results:
(meeting-time (Aull DeWitt) (Wednesday 4pm))
;;; Query input:
(meeting-time (Aull DeWitt) (Monday . ?time))

;;; Query results:
(meeting-time (Aull DeWitt) (Monday 10am))
;;; Query input:
Exercise 4.60

２回表示されるのは出力例にある様に、Alyssaがperson-1に割り当てられてperson-2を探してCyを見つけた時と、Cyをperson-1に割り当ててAlyssaを見つけた時のどちらも表示されるから。
実際の結果

;;; Query input:
(lives-near ?person-1 ?person-2)

;;; Query results:
(lives-near (Aull DeWitt) (Reasoner Louis))
(lives-near (Aull DeWitt) (Bitdiddle Ben))
(lives-near (Reasoner Louis) (Aull DeWitt))
(lives-near (Reasoner Louis) (Bitdiddle Ben))
(lives-near (Hacker Alyssa P) (Fect Cy D))
(lives-near (Fect Cy D) (Hacker Alyssa P))
(lives-near (Bitdiddle Ben) (Aull DeWitt))
(lives-near (Bitdiddle Ben) (Reasoner Louis))
;;; Query input:

２回表示させるのを防ぐ方法。基本的には対象となるデータの順序を判断する事になる。何とか

  1. 新しいデータを導入せず
  2. 評価器に変更を加えず
  3. このquery languageの文法内で出来ないものか

と考えたが、どうもlisp-valueに頼らざるを得ない感じ。
Racketのfoldrを使って半ば強引にシンボルのリストを文字列にして名前を比較。

;;; Query input:
(and (lives-near ?person-1 ?person-2)
     (lisp-value (lambda (a b) (define (conv name) (foldr string-append "" (map symbol->string name))) (string<? (conv a) (conv b))) ?person-1 ?person-2))

;;; Query results:
(and (lives-near (Aull DeWitt) (Reasoner Louis)) (lisp-value (lambda (a b) (define (conv name) (foldr string-append  (map symbol->string name))) (string<? (conv a) (conv b))) (Aull DeWitt) (Reasoner Louis)))
(and (lives-near (Aull DeWitt) (Bitdiddle Ben)) (lisp-value (lambda (a b) (define (conv name) (foldr string-append  (map symbol->string name))) (string<? (conv a) (conv b))) (Aull DeWitt) (Bitdiddle Ben)))
(and (lives-near (Fect Cy D) (Hacker Alyssa P)) (lisp-value (lambda (a b) (define (conv name) (foldr string-append  (map symbol->string name))) (string<? (conv a) (conv b))) (Fect Cy D) (Hacker Alyssa P)))
(and (lives-near (Bitdiddle Ben) (Reasoner Louis)) (lisp-value (lambda (a b) (define (conv name) (foldr string-append  (map symbol->string name))) (string<? (conv a) (conv b))) (Bitdiddle Ben) (Reasoner Louis)))
;;; Query input:

ただこれでは出力が見にくいので、新しいルールを作る。

;;; Query input:
(assert! (rule (lives-near-2 ?person-1 ?person-2)
               (and (address ?person-1 (?town . ?rest-1))
                    (address ?person-2 (?town . ?rest-2))
                    (not (same ?person-1 ?person-2))
                    (lisp-value (lambda (a b) (define (conv name) (foldr string-append "" (map symbol->string name))) (string<? (conv a) (conv b))) ?person-1 ?person-2))))

Assertion added to data base.
;;; Query input:
(lives-near-2 ?person-1 ?person-2)

;;; Query results:
(lives-near-2 (Aull DeWitt) (Reasoner Louis))
(lives-near-2 (Aull DeWitt) (Bitdiddle Ben))
(lives-near-2 (Fect Cy D) (Hacker Alyssa P))
(lives-near-2 (Bitdiddle Ben) (Reasoner Louis))
;;; Query input:

一応出来ているかな。

Logic as programs

Logical implicationは論理的含意？
パターン変数がルールの本文を満足しているとき、その変数の値はその結論を満足している。
これを使ってlogical deduction（論理的推論）が可能。

appendのルールをもう一度見直してみると、（appendを+と表記すると）

  1. ()+?y=?yである。
  2. ?v+?y=?zであるとき、(?u . ?v)+?y=(?u . ?z)である。

ルールの本体にappend-to-formが出て来ているので再帰的に適用している感じ。
第１引数のcdrをどんどん取って行って、最終的に空リストになると最初のルールを満足する。ここから再帰されていたルールを戻るイメージ。
つまり?vが空になったら、?uは最初のリストの最後の要素（?u0とする）。appendの結果?zはは(?u0 . ?y)。
その１段手前では、?uは最後から２番目の要素（?u1とする）。appendの結果は(?u1 . ?z)。ここの?zは前の段の結果なので(?u0 . ?y)だから、この段での?zは(?u1 . (?u0 . ?y))。
と言った具合。

;;; Query input:
(assert! (rule (append-to-form () ?y ?y)))
(assert! (rule (append-to-form (?u . ?v) ?y (?u . ?z))
      (append-to-form ?v ?y ?z)))

Assertion added to data base.
;;; Query input:

Assertion added to data base.
;;; Query input:
(append-to-form (a b) (c d) ?z)

;;; Query results:
(append-to-form (a b) (c d) (a b c d))
;;; Query input:

未知数（数じゃないけど）を入力側に持って来る事も可能。ただこの動きはこの先を読まないと分からない。

;;; Query input:
(append-to-form (a b) ?y (a b c d))

;;; Query results:
(append-to-form (a b) (c d) (a b c d))
;;; Query input:
(append-to-form ?x ?y (a b c d))

;;; Query results:
(append-to-form (a b c d) () (a b c d))
(append-to-form () (a b c d) (a b c d))
(append-to-form (a) (b c d) (a b c d))
(append-to-form (a b) (c d) (a b c d))
(append-to-form (a b c) (d) (a b c d))
;;; Query input:
Exerise 4.61

中置記法も出来るのか。
(?x next-to ?y in (1 (2 3) 4))に対しては、?x=1、?y=(2 3)。
(?x next-to 1 in (2 1 3 1))に対しては、?x=2と予想。

;;; Query input:
(assert! (rule (?x next-to ?y in (?x ?y . ?u))))

Assertion added to data base.
;;; Query input:
(assert! (rule (?x next-to ?y in (?v . ?z))
      (?x next-to ?y in ?z)))

Assertion added to data base.
;;; Query input:
(?x next-to ?y in (1 (2 3) 4))

;;; Query results:
((2 3) next-to 4 in (1 (2 3) 4))
(1 next-to (2 3) in (1 (2 3) 4))
;;; Query input:
(?x next-to 1 in (2 1 3 1))

;;; Query results:
(3 next-to 1 in (2 1 3 1))
(2 next-to 1 in (2 1 3 1))
;;; Query input:

お、なるほど。3もありか。

Exercise 4.62

忘れ勝ちなのは結果が入る変数も引数の様に持つ必要がある事。なので変数（引数）はリストと要素。last-pairと言っても最後のconsペアの事なので、最後の要素とNilをポイントする最後のペアの事。
これまでと同じ感じで、

  1. リストのcdrが空であれば、carが最後の要素
  2. リストのcdrが空でなければ、cdrの最後の要素を探す
(rule (last-pair (?y . ()) ?y))
(rule (last-pair (?x . ?y) ?z)
      (last-pair ?y ?z))

実行結果

;;; Query input:
(last-pair (3) ?x)

;;; Query results:
(last-pair (3) 3)
;;; Query input:
(last-pair (1 2 3) ?x)

;;; Query results:
(last-pair (1 2 3) 3)
;;; Query input:
(last-pair (2 ?x) (3))

;;; Query results:
(last-pair (2 (3)) (3))
;;; Query input:
(last-pair ?x (3))

;;; Query results:. . user break
>

(last-pair ?x (3))に対しては答えが戻って来ない。
理屈としては3を最後の要素に持つ任意の長さのリストが?xに当てはまるので?xは確定しない。
具体的に考えると3の前に何を持って来るのかどうやって決めようとしているのか、どこでループにはまっているのかは実装の詳細を学ばないと分からない。

Exercise 4.63

子供とはsonで定義された子供と、妻の子供の両方があるのでson-ofと言うルールを作る。

(rule (son-of ?parent ?son)
      (or (son ?parent ?son)
          (and (wife ?parent ?mother)
               (son ?mother ?son))))

(rule (grand-son-of ?grand-father ?grand-son)
      (and (son-of ?grand-father ?father)
           (son-of ?father ?grand-son)))

実行結果

;;; Query input:
(grand-son-of Cain ?x)

;;; Query results:
(grand-son-of Cain Irad)
;;; Query input:
(son-of Lamech ?x)

;;; Query results:
(son-of Lamech Jubal)
(son-of Lamech Jabal)
;;; Query input:
(grand-son-of Methushael ?x)

;;; Query results:
(grand-son-of Methushael Jubal)
(grand-son-of Methushael Jabal)
;;; Query input: