@uents blog

Code wins arguments.

SICP 読書ノート#66 - 4.4.2-4.4.3 質問システムはどう働くか〜論理プログラミングは数学的論理か (pp.270-278)

SICP Scheme

一気に流し読みしましたが、説明ばかりでいまいち頭に入ってこない。

気になる記述を適当にメモ書き。

質問システム

  • pattern matchingとunificationを中心に構成される

パターンマッチング

  • pattern matcherはあるデータが指定されたパターン(例：(job ?x ?y))に適合するかをテストするプログラム
  • pattern matcherはパターン、データ、およびパターン変数の束縛を規定するframeを取る
    • Scheme処理系のenvironmentのframeと同じような感じ？
  • frameはstreamを使って構成される
    • なぜstream？ 単純なqueueではだめ？

合成質問

  • パターン変数(例：?x)の束縛は、前の質問から順に行われる (たぶん)

ユニフィケーション

  • パターン変数が複数ある場合に推論的に束縛させていくプログラム？
  • データベースから規則を読み出してパターンマッチを行う (こともある？)

規則の作用

ユニフィケーションの具体例。こんな感じで合ってる？

(1) (lives-near ?x (Hacker Alyssa P)を規則のlives-nearにマッチさせる。結果は以下の通り

(and (address ?x (?town . ?rest-1))
     (address (Hacker Alyssa P) (?town . ?rest-2))
     (not (same ?x (Hacker Alyssa P))))

(2) データベースから(address ?x (?town . ?rest-1)にマッチするパターンが読み出され、 残りテスト、

    (address (Hacker Alyssa P) (?town . ?rest-2))
     (not (same ?x (Hacker Alyssa P)))

で真となるかのフィルタリングが行われる

(3) 真となった場合、出力ストリームに追加される

無限ループ

  • パターン変数の束縛が収束しない場合に発生する

notに関する問題

  • (not P)は「Pが真ではない」にあらず
  • 「Pがデータベースの知識からは推論できない」が正しい

問題 4.64

?middle-managerが未束縛のままoutranked-byの再帰呼び出しを行うため、上手く動作しない。

問題 4.65

wheelの規則の実装を見ればわかるが、

(rule (wheel ?person)
      (and (supervisor ?middle-manager ?person)
           (supervisor ?x ?middle-manager)))

社長であるOliverには直属のmiddle managerが4人もいるので、4回ヒットし出力される。

問題 4.66

query systemをhackしてaccumulation-funcitonを追加する必要があると思うが、まだquery systemの実装を見ていないのでパス。(§4.4.4で見る模様)

問題 4.67

これもquery systemの実装を見ていないのでパス

問題 4.68

append-to-fromを使ってreverseの規則を追加する。

まずは問題2.18のreverseをappendを使って実装し直す。

(define (reverse lst)
  (if (null? lst)
      lst
      (append (reverse (cdr lst)) (list (car lst)))))

これを公理的定義で表すと、

  • (reverse (?z . ())) => (?z)
  • (reverse ?v) => ?y かつ (append ?y (?u)) => ?x であるならば、 (reverse (?u . ?v)) => ?x

よってreverseの規則は以下の通り。

(assert! (rule (reverse (?z . ())  (?z))))

(assert! (rule (reverse (?u . ?v) ?x)
               (and (reverse ?v ?y)
                    (append-to-from ?y (?u) ?x))))

テスト。

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

;;; Query results:
(reverse (1) (1))

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

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

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

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

;;; Query input:
(reverse ?x (3 2 1)) ;;=> 返ってこない

問題 4.69

問題4.63のデータと規則に加えて、

(assert! (rule ((great . ?relation) ?x ?y)
               (and (son ?x ?m)
                    (?relation ?m ?y))))

(assert! (rule ((grandson) ?g ?ggs)
               (grandson-of ?g ?ggs)))

とすると、

;;; Query input:
((great grandson) ?x ?y)

;;; Query results:
((great grandson) Irad Lamech)
((great grandson) Enoch Methushael)
((great grandson) Cain Mehujael)
((great grandson) Adam Irad)

次は「§4.4.4 質問システムの実装」から。

※「SICP読書ノート」の目次はこちら

SICP 読書ノート#65 - 4.4.1 プログラムとしての論理 (pp.269-270)

SICP Scheme

§4.4.1の続き「プログラムとしての論理」から。

プログラムとしての論理

規則は一種の論理的包含(logical implication)と見ることが出来る: 値のパターン変数への代入が, 本体を満足すれば, それは結論を満足する. 従って質問言語を, 規則に基づいて論理的推論(logical deductions)を実行する能力があると見ることが出来る.

冒頭からイミフです。

まずは論理的包含を調べてみました。

… 2つの命題 P と Q に対する論理包含を P → Q などと書き、「P ならば Q」と読む。命題 P → Q に対し、P をその前件、Q をその後件などと呼ぶ。

これを規則(rule)で表すとこうです。

(rule Q P)

よって質問言語(query language)は論理的推論の実行能力があると結論づけているようです。

＊＊＊

次にappendの例。まずappendの実装を振り返ると、

(define (append x y)
  (if (null? x)
      y
      (cons (car x) (append (cdr x) y))))

という実装は、

  • xが()なら、(append x y) => y
  • xが任意のリストなら、(append x y) => ((car x) . (append (cdr x) y)

という定義づけを行ってる、とも言えます。

さらに、

  • xが()なら、(append x y) => y

の公理的定義は、本文の

任意のリストyについて, 空リストとyをappendするとyになる

に、

  • xが任意のリストなら、(append x y) => ((car x) . (append (cdr x) y))

は、

任意のu, v, yとzについて, vとyをappendしてzになるなら, (cons u v)とyをappendすると, (cons u z)になる.

に、相当します。

前者の条件はまあそのままですが、後者の条件はぱっと見よくわかりません。

もう少し噛み砕いて、

任意のu, v, yとzについて, vとyをappendしてzになる

を、(append v y) => z

(cons u v)とyをappendすると, (cons u z)になる

を、(append (u . v) y) => (u . z) と表し直してみます。

ここで x = (u . v)とすると、

  1. (append x y) = (append (u . v) y) = (u . z) となり、
  2. z = (append v y) から、
  3. (u . z) = (u . (append v y)) = ((car x) . (append (cdr x) y)

と変形できます。

ゆえに、

  • xが任意のリストなら、(append x y) => ((car x) . (append (cdr x) y)

の公理的定義は、

任意のu, v, yとzについて, vとyをappendしてzになるなら, (cons u v)とyをappendすると, (cons u z)になる.

と表現できます。

＊＊＊

次に、上記の公理的定義を表す規則を質問システムに追加してみます。

規則やデータを動的に追加するには(assert! ...)が使えるようです。

;;; Query input:
(assert! (rule (append-to-from () ?y ?y)))

Assertion added to data base.

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

Assertion added to data base.

続けてappend-to-fromを実行させてみます。

;;; Query input:
(append-to-from (a b) (c d) ?z)

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

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

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

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

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

本文の通りに動きました。ごいすー。

問題 4.61

リストの隣の要素を見つけます。

;;; 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))

問題 4.62

まず問題2.17の解答のlast-pairを見てみる。

(define (last-pair lst)
  (cond ((null? lst) nil)
        ((null? (cdr lst)) lst)
        (else (last-pair (cdr lst)))))

これを公理的定義で表すと、

  • 任意のアトム(z . ())に対し、(last-pair (z . ())) => z
  • 任意のリスト(u . v)に対し、 (last-pair v) => xとなるなら(last-pair (u . v)) => x

よって規則の実装は、

(rule (last-pair (?z . ()) ?z))
(rule (last-pair (?u . ?v) ?x)
      (last-pair ?v ?x))

質問システムに組み込んでテスト。

;;; Query input:
(assert! (rule (last-pair (?z . ()) ?z)))

Assertion added to data base.

;;; Query input:
(assert! (rule (last-pair (?u . ?v) ?x)
               (last-pair ?v ?x)))

Assertion added to data base.

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

;;; Query results:
(last-pair (3) 3)

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

;;; Query results:
(last-pair (5) 5)

;;; Query input:
(last-pair (23 72 149 34) ?x)

;;; Query results:
(last-pair (23 72 149 34) 34)

問題 4.63

grandson-ofとson-ofの規則はそれぞれ以下の通り。

(rule (grandson-of ?g ?s)
      (and (son ?f ?s)
           (son ?g ?f)))

(rule (son-of ?m ?s)
      (and (wife ?m ?w)
           (son ?w ?s))))

データベースと規則をassert!で表明。

(assert! (son Adam Cain))
(assert! (son Cain Enoch))
(assert! (son Enoch Irad))
(assert! (son Irad Mehujael))
(assert! (son Mehujael Methushael))
(assert! (son Methushael Lamech))
(assert! (wife Lamech Ada))
(assert! (son Ada Jabal))
(assert! (son Ada Jubal))

(assert! (rule (grandson-of ?g ?s)
               (and (son ?f ?s)
                    (son ?g ?f))))

(assert! (rule (son-of ?m ?s)
               (and (wife ?m ?w)
                    (son ?w ?s))))

テスト。個人的に聖書の知見は0だけど、たぶん動いてそう。

;;; Query input:
(grandson-of ?x ?y)

;;; Query results:
(grandson-of Mehujael Lamech)
(grandson-of Irad Methushael)
(grandson-of Enoch Mehujael)
(grandson-of Cain Irad)
(grandson-of Adam Enoch)

;;; Query input:
(son-of ?x ?y)

;;; Query results:
(son-of Lamech Jubal)
(son-of Lamech Jabal)

次は「§4.4.2 質問システムはどう働くか」から。

※「SICP読書ノート」の目次はこちら

SICP 読書ノート#64 - 4.4 論理型プログラミング (pp.261-269)

SICP Scheme

いよいよ4章の最後のセクション「論理型プログラミング」に入りました。

ここでのキーワードは「一方向性計算から多方向性計算へ」と「ユニフィケーション」のようです。

また、本文のappendの定義について

(define (append x y)
  (if (null? x)
      y
      (cons (car x) (append (cdr x) y))))

に対し、

この手続きは, 次の二つの規則をLispに翻訳したものと考えられる. 第一の規則は, 第一のリストが空の場合を扱い, 第二は二つの部分のconsである, 空ではないリストの場合を扱う:

• 任意のリストyについて, 空リストとyをappendするとyになる.

• 任意のu, v, yとzについて, vとyをappendしてzになるなら, (cons u v)とyをappendすると, (cons u z)になる

を公理的定義というようですが、後から出てくるのでひとまず置いておきます。

質問システムを動かす

まずは質問システム(query system)を動かしてみます。

ソースコードはGitHubに置いています。

1. SICP本家からサンプルコードを取得

% curl -O https://mitpress.mit.edu/sicp/code/ch4-query.scm

2. Racket処理系で解釈できるようにいくつか修正

  • ファイルの先頭に#lang racketのシェバンを追加
  • evalの引数user-initial-environmentを削除
@@ -124,8 +126,8 @@
 ;;(put 'lisp-value 'qeval lisp-value)
 
 (define (execute exp)
-  (apply (eval (predicate exp) user-initial-environment)
-         (args exp)))
+  (apply (eval (predicate exp))
+        (args exp)))
 
 (define (always-true ignore frame-stream) frame-stream)
  • ifでalternative節がないものに便宜的にfalseを追加
    • Racketはalternatie節の省略を許さない
@@ -296,7 +298,8 @@
           (put key
                'assertion-stream
                (cons-stream assertion
-                            current-assertion-stream))))))
+                            current-assertion-stream))))
+     false))
 
 (define (store-rule-in-index rule)
   (let ((pattern (conclusion rule)))
@@ -307,7 +310,8 @@
             (put key
                  'rule-stream
                  (cons-stream rule
-                              current-rule-stream)))))))
+                              current-rule-stream))))
+       false)))
  • stream support と table support は別ファイルに分ける
    • 別ファイルに分けておくとDrRacketのステップ実行で入り込まなくて済むので、個人的には都合がいい
    • tables.scmではmutable pairsを使うので(require r5rs)を追加
;;;;Stream support from Chapter 3
(require "streams.scm")

;;;;Table support from Chapter 3, Section 3.3.3 (local tables)
(require "tables.scm")
  • ファイルの最後に以下を追加
+;;; run driver loop
+(initialize-data-base microshaft-data-base)

3. 質問システムを起動

ch4-query.scmをロードしquery-driver-loopを呼び出すと質問システムのREPLが起きて入力プロンプトが表示される。

racket@> ,enter "ch4-query.scm"
'done
racket@ch4-query.scm> (query-driver-loop)

;;; Query input:

単純質問

テキストの例を写経。

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

;;; Query results:
(job (Fect Cy D) (computer programmer))
(job (Hacker Alyssa P) (computer programmer))
  • 全ての社員の住所をリストアップ
;;; 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:
(job ?who (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:
(job ?who (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))

問題 4.55

a. Ben Bitdiddleに監督されている人すべて

;;; Query input:
(supervisor ?who (Bitdiddle Ben))

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

b. 経理部門 [accounting division] のすべての人の名前と担当

;;; Query input:
(job ?who (accounting . ?type))

;;; Query results:
(job (Cratchet Robert) (accounting scrivener))
(job (Scrooge Eben) (accounting chief accountant))

c. Slumerville に住む人すべての名前と住所

;;; Query input:
(address ?who (Slumerville . ?where))

;;; 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:
(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)))
  • Ben Bitdiddle か Alyssa P. Hacker が監督するすべての従業員
;;; 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)))
  • Ben Bitdiddleが監督し、計算機プログラマでない人すべて
;;; 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))))
  • 給料が30,000ドルより多い人すべて
;;; 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))

問題 4.56

a. Ben Bitdiddleが監督している人すべての名前とその住所

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

;;; Query results:
(and (supervisor (Tweakit Lem E) (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 (Hacker Alyssa P) (Cambridge (Mass Ave) 78)))

b. 給料がBen Bitdiddleのそれより少ない人のすべてと、その人たちの給料と、Ben Bitdiddleの給料

;;; Query input:
(and (salary (Bitdiddle Ben) ?ben-amount)
     (and (salary ?person ?amount)
          (lisp-value < ?amount ?ben-amount)))

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

c. 計算機部門にいない人が監督している人すべてと、その監督者の名前と担当

;;; Query input:
(and (supervisor ?staff-person ?boss)
     (not (job ?boss (computer . ?type)))
     (job ?boss ?job))

;;; Query results:
(and (supervisor (Aull DeWitt) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?type))) (job (Warbucks Oliver) (administration big wheel)))
(and (supervisor (Cratchet Robert) (Scrooge Eben)) (not (job (Scrooge Eben) (computer . ?type))) (job (Scrooge Eben) (accounting chief accountant)))
(and (supervisor (Scrooge Eben) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?type))) (job (Warbucks Oliver) (administration big wheel)))
(and (supervisor (Bitdiddle Ben) (Warbucks Oliver)) (not (job (Warbucks Oliver) (computer . ?type))) (job (Warbucks Oliver) (administration big wheel)))

見づらいのでまとめると、

計算機部門にいない人が監督している人 監督者の名前 監督者の担当
Aull DeWitt Warbucks Oliver administration big wheel
Cratchet Robert Scrooge Even accounting chief accountant
Scrooge Eben Warbucks Oliver 同上
Bitdiddle Ben Warbucks Oliver 同上

規則

規則(rule)は質問(query)そのものを抽象化する手段を提供します。

  • 同じ町に住む人を見つける規則 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))))
  • 同じかどうかをチェックする規則 same
(rule (same ?x ?x))
  • 監督者を監督する人を見つける wheel
(rule (wheel ?person)
      (and (supervisor ?middle-manager ?person)
           (supervisor ?x ?middle-manager)))
  • スタッフとボスの関係を表す outranked-by。再帰的に表現することもできる
(rule (outranked-by ?staff-person ?boss)
      (or (supervisor ?staff-person ?boss)
          (and (supervisor ?staff-person ?middle-manager)
               (outranked-by ?middle-manager ?boss))))

これらの規則を使って質問を投げかけてみる。

  • 近くに住んでいる規則の規定と、Ben Bitdiddleの近くに住む人は誰か？
;;; Query input:
(lives-near ?who (Bitdiddle Ben))

;;; Query results:
(lives-near (Aull DeWitt) (Bitdiddle Ben))
(lives-near (Reasoner Louis) (Bitdiddle Ben))

;;; Query input:
(and (job ?x (computer . ?type))
     (lives-near ?x (Bitdiddle Ben)))

;;; Query results:
(and (job (Reasoner Louis) (computer programmer trainee)) (lives-near (Reasoner Louis) (Bitdiddle Ben)))

問題 4.57

マイクロシャフト社のデータベース microshaft-data-base に以下の規則を追加する。

(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))))

a. Cy D. Fectに代われる人すべて

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

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

b. 誰かに代われて、その誰かのほうが多くの給料をもらっている人全てと両者の給料

;;; Query input:
(and (replace ?person-1 ?person-2)
     (salary ?person-1 ?salary-1)
     (salary ?person-2 ?salary-2)
     (lisp-value > ?salary-1 ?salary-2))

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

問題 4.58

microshaft-data-baseに以下の規則を追加する。

(rule (big-shot ?person)
      (and (supervisor ?person ?boss)
           (not (replace ?boss ?person))))

テスト。

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

;;; Query results:
(big-shot (Aull DeWitt))
(big-shot (Cratchet Robert))
(big-shot (Scrooge Eben))
(big-shot (Bitdiddle Ben))

問題 4.59

microshaft-data-baseに以下を追加する。

(meeting accounting (Monday 9am))
(meeting administration (Monday 10am))
(meeting computer (Wednesday 3pm))
(meeting administration (Friday 1pm))
(meeting whole-company (Wednesday 4pm))

a. 金曜にあるすべてのミーティング

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

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

b. (rule (metting-time ?person ?day-and-time) <rule-body>) を実装

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

c. Alyssaが出席すべき水曜のミーティング

;;; 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))

問題 4.60

  • 理由は、規則lives-nearが重複チェックを(not (same ?person-1 ?person-2))でしかしていないため
  • 重複チェックとしてさらに名前の比較チェックを追加すればよい。実装はパス

次回は「プログラムとしての論理」から。

※「SICP読書ノート」の目次はこちら

SICP 読書ノート#63 - 4.3.3 amb評価器の実装 (pp.254-261)

SICP Scheme

この節ではamb評価器の内部に迫ります。

個人的には自前でambオペレータを作った際に、継続やバックトラックと散々戯れたので、ここはさらっと読み流します。

amb評価器で重要そうなのは、やはりamb式の評価ですよね。

(define (analyze-amb exp)
  (let ((cprocs (map analyze (amb-choices exp))))
    (lambda (env succeed fail)
      (define (try-next choices)
        (if (null? choices)
            (fail)
            ((car choices) env
                           succeed
                           (lambda ()
                             (try-next (cdr choices))))))
      (try-next cprocs))))
  • まず、ambの選択肢を評価し、実行手続きに変換する
  • 次に、
    • 選択肢がなければ(fail)させる (→バックトラックが発生)
    • 選択肢が残っていれば、残りの選択肢をfail側に継続渡しして最初の実行手続きを実行させる
  • ような実行手続きを返す

amb評価器は継続渡しスタイルで非決定性決算を実装しているだけで、本質的にはcall-ccを使った自前のaambオペレータと変わらないと思います。

(define *alternatives* '())

(define (choose choices)
  (if (null? choices)
      (try-again)
      (call/cc
       (lambda (cc)
         (define try-next
           (lambda () (cc (choose (cdr choices)))))
         (set! *alternatives*
               (cons try-next *alternatives*))
         (force (car choices))))))

;; ...

(define (amb . choices)
  (choose choices))

というわけで、理解したということにして先へ進みます。

SICPで全部の問題解いている人、ほんとすごいよなぁ (遠い目...)

次は「§4.4 論理型プログラミング」から。

※「SICP読書ノート」の目次はこちら

SICP 読書ノート#62 - 4.3.2 自然言語の構文解析 (pp.250-253)

SICP Scheme

§4.3.2 の続き「自然言語の構文解析」から。

「そもそもこれ自前のambオペレータで動く？」という疑問はありますが、コードを書いてみます。

ambの引数に式を与える際、自前のambオペレータは単なる手続きなのでdelayさせます。

(define nouns '(noun student professor cat class))

(define verbs '(verb studies lectures eats sleeps))

(define articles '(article the a)) ;; 冠詞

(define prepositions '(prep for to in by with)) ;; 前置詞


(define (parse-word word-list)
  (req (not (null? *unparsed*)))
  (req (memq (car *unparsed*) (cdr word-list)))
  (let ((found-word (car *unparsed*)))
    (set! *unparsed* (cdr *unparsed*))
    (list (car word-list) found-word)))

(define *unparsed* '())

(define (parse input)
  (set! *unparsed* input)
  (let ((sent (parse-sentence)))
    (req (null? *unparsed*))
    sent))

(define (parse-sentence)
  (list 'sentence
        (parse-noun-phrase)
        (parse-verb-phrase)))

(define (parse-noun-phrase)
  (list 'noun-phrase
        (parse-word articles)
        (parse-word nouns)))

(define (parse-prepositional-phrase)
  (list 'prep-phrase
        (parse-word prepositions)
        (parse-noun-phrase)))

(define (parse-verb-phrase)
  (define (maybe-extend verb-phrase)
    (amb verb-phrase
         (delay (maybe-extend (list 'verb-phrase
                                    verb-phrase
                                    (parse-prepositional-phrase))))))
  (maybe-extend (parse-word verbs)))

(define (parse-simple-noun-phrase)
  (list 'simple-noun-phrase
        (parse-word articles)
        (parse-word nouns)))

(define (parse-noun-phrase)
  (define (maybe-extend noun-phrase)
    (amb noun-phrase
         (delay (maybe-extend (list 'noun-phrase
                                    noun-phrase
                                    (parse-prepositional-phrase))))))
  (maybe-extend (parse-simple-noun-phrase)))

テスト。

racket@> (parse '(the cat eats))
=> '(sentence (noun-phrase (article the) (noun cat)) (verb eats))

racket@> (parse '(the student in the cat sleeps))
=> '(sentence
     (noun-phrase
      (simple-noun-phrase (article the) (noun student))
      (prep-phrase (prep in) (simple-noun-phrase (article the) (noun cat))))
     (verb sleeps))

おおっ！

racket@> (parse '(the student with the cat sleeps in the class))
=> '(sentence
     (noun-phrase
      (simple-noun-phrase (article the) (noun student))
      (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat))))
     (verb-phrase
      (verb sleeps)
      (prep-phrase (prep in) (simple-noun-phrase (article the) (noun class)))))

いけるやん！

ただ、

racket@> (parse '(the professor lectures to the student with the cat))
=> '(sentence
     (simple-noun-phrase (article the) (noun professor))
     (verb-phrase
      (verb-phrase
       (verb lectures)
       (prep-phrase (prep to) (simple-noun-phrase (article the) (noun student))))
      (prep-phrase (prep with) (simple-noun-phrase (article the) (noun cat)))))

racket@> (try-again)
=> '(there are no more values)  ;; もう1つの解が出ない...

となりました。残念。。

構文木が上手く作れていないのか、バックトラックに失敗しているのかわかりませんが、いまいち深追いする気になれず。。

まあこうやって自然言語の構文解析するんだなというのがふわっとわかったので、先へ進みます。

※「SICP読書ノート」の目次はこちら