Ex. 4.78
amb評価器の上に query評価器を構築する。なんていう壮大な計画はとうぜん没。
amb評価器上で、検索プログラムを作るという感じで。（これでも結構大変）
一応、目標とする動作は
;;; Amb input aaa = (amb THE-ASSERTIONS) (require (match? '(son Ada ?x) aaa)) (print aaa) ;;; Amb output (son Ada Jabal) ;;; Amb input try-again ;;; Amb output (son Ada Jubal)
こんな感じで。
関数 match? は、ambの組み込み関数にするか、amb上で定義するユーザ関数にするか、の2択だが、特にややこしくする理由もないので単純にユーザ関数にする。
amb評価器の本体の改造
(define primitive-procedures
(list (list 'car car)
...
(list 'equal? equal?) ;; 追加
(list 'string=? string=?) ;; 追加
(list 'symbol->string symbol->string) ;; 追加
(list 'pair? pair?) ;; 追加
(list 'substring substring) ;; 追加
))
amb評価器上で定義するユーザ関数とグローバル変数
;;; Amb-Eval input:
(define THE-ASSERTIONS
'((son Adam Cain)
(son Cain Enoch)
(son Enoch Irad)
(son Irad Mehujael)
(son Mehujael Methushael)
(son Methushael Lamech)
(wife Lamech Ada)
(son Ada Jabal)
(son Ada Jubal)))
;;; Amb-Eval input:
(define (var? symbol)
(string=? "?" (substring (symbol->string symbol) 0 1)))
;;; Amb-Eval input:
;; フレームから変数の値探す。
;; 変数は ?x とか、フレームは ((?x . abc) (?y . 123)) とか。
(define (search-value x frame)
(if (null? frame)
false
(if (equal? x (car (car frame)))
(cdr (car frame))
(search-value x (cdr frame)))))
;;; Amb-Eval input:
;; パターンと表明のマッチを調べる。
;; pattern は (son Ada ?x) とか、assertion は (son Ada Jubal)とか、
;; frameは((?x . abc) (?y . 123))とか
(define (match? pattern assertion frame)
(cond ((equal? pattern assertion) frame) ;; パターンと表明が一致してればマッチ成功
((pair? pattern)
(if (pair? assertion)
(let ((ppp (car pattern)) ;; パターンの先頭と
(aaa (car assertion))) ;; 表明の先頭を比較する。
(if (var? ppp) ;; 変数の時
(let ((vvv (search-value ppp frame))) ;; フレームから変数さがす
(if (eq? vvv false) ;; 変数なかったらフレームに追加してマッチ続行
(match? (cdr pattern) (cdr assertion) (cons (cons ppp aaa) frame))
(if (equal? aaa vvv) ;; 変数が既にあって、値が同じならマッチ続行
(match? (cdr pattern) (cdr assertion) frame)
false))) ;; 変数が食い違っていたらマッチ失敗
(if (equal? aaa ppp) ;; 変数でなくシンボルのとき。一致していたらマッチ続行。
(match? (cdr pattern) (cdr assertion) frame)
false))) ;; 一致してなかったらマッチ失敗。
false)) ;; 他はマッチ失敗
(else false)))
;;; Amb-Eval input:
;;p.246
(define (an-element-of items)
(require (not (null? items)))
(amb (car items) (an-element-of (cdr items))))
テスト
;;; Amb-Eval input: (let ((aaa (an-element-of THE-ASSERTIONS))) (require (match? '(son Ada ?x) aaa '())) aaa) ;;; Starting a new problem ;;; Amb-Eval value: (son Ada Jabal) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (son Ada Jubal) ;;; Amb-Eval input: try-again ;;; There are no more values of
amb が an-element-of になったりしてるが、だいたいOK。
次は、and を作ってみる。
やり方は2通り考えられる。
① requireを2つ並べると and の代わりにできる。
;;; Amb input aaa = (amb THE-ASSERTIONS))) bbb = (amb THE-ASSERTIONS))) (require (match? '(wife Lamech ?x) aaa)) (require (match? '(son ?x ?y) bbb)) (list aaa bbb)
② require 1つで対処。conjoin関数を追加。
;;; Amb input
aaa = (amb THE-ASSERTIONS)
bbb = (amb THE-ASSERTIONS)
(require (conjoin (match? '(wife Lamech ?x) aaa)
(match? '(son ?x ?y) bbb)))
(list aaa bbb)
なんかこんな感じで。どっちでもいいけど、① だと新しい関数を作らなくてもいいので ① でいく。
;;; Amb-Eval input:
(let ((aaa (an-element-of THE-ASSERTIONS))
(bbb (an-element-of THE-ASSERTIONS)))
(let ((frame (match? '(wife Lamech ?x) aaa '())))
(require frame)
(require (match? '(son ?x ?y) bbb frame)))
(list aaa bbb))
;;; Starting a new problem
;;; Amb-Eval value:
((wife Lamech Ada) (son Ada Jabal))
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
((wife Lamech Ada) (son Ada Jubal))
;;; Amb-Eval input:
try-again
;;; There are no more values of
frameの引き渡しが若干面倒だが、だいたいOK。
次は not 。これも新しく negate関数つくらなくても、amb評価機の not を使えばOK。
;;; Amb-Eval input: (let ((aaa (an-element-of THE-ASSERTIONS))) (require (not (match? '(son Ada ?x) aaa '()))) aaa) ;;; Starting a new problem ;;; Amb-Eval value: (son Adam Cain) ;;; Amb-Eval input: try-again ;;; Amb-Eval value: (son Cain Enoch) ...
次は or 、これも新しい関数(disjoin)なしの方向で。
A or B だが、amb評価器には or シンタックスが実装されていないので、if 文を利用する。
;;; Amb-Eval input:
(let ((aaa (an-element-of THE-ASSERTIONS)))
(let ((frame (match? '(son Ada ?x) aaa '())))
(if frame
(require true)
(require (match? '(son Adam ?x) aaa '())))
aaa))
;;; Starting a new problem
;;; Amb-Eval value:
(son Adam Cain)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(son Ada Jabal)
;;; Amb-Eval input:
try-again
;;; Amb-Eval value:
(son Ada Jubal)
;;; Amb-Eval input:
try-again
;;; There are no more values of
次は rule ですが、、、降参です。
一応、理由を列挙。
- same関数くらいは単純に amb の define で作ればOKな気がする。
- wheel関数は、関数の中でDB検索させる方法が？(ユーザ関数の中で amb を使っていい？そのときの動作は？)
- son関数は、表明のsonと関数sonを混在させる方法が？
- outranked-by関数は、無限ループする関数だが、どうやって無限ループさせるか？
まあ、こんな感じでもういいです。疲れました。
次に amb 上の query と query評価器の違いについて。上でみたようにずいぶん違う。私の作り方が悪いだけかもしれないが。
and の動作はまあまあ同じ。
not の動作は明らかに異なる。amb で作ると、(not B) が (All and (not B)) として出てくる。
or の動作もまあまあ同じ。表示のさせかたが違うだけ。
基本的に、amb 上の query は、query評価器に比べて frame をユーザが弄るので、異なる動作にすることは簡単だと思われる。なるべく同じような動作をさせることも可能だと思うが、どこまでも同じにできるかは？