前回作成した関数 match はパターンとデータを照合するものでした。今度はパターンとパターンを照合するユニフィケーション (unification) [*2] を作ってみましょう。関数名は unify とします。unify はパターン変数とパターン変数を照合する分だけ match よりも処理は複雑になります。パターンマッチングの応用では match で十分な場合もありますが、このあとで作成する Prolog 風の簡易エキスパートシステムではユニフィケーションが必要になります。次の実行例を見てください。
(unify '(太郎 好き コーヒー) '(太郎 好き ?x) nil)
=> ((?x . コーヒー))
(unify '(太郎 好き コーヒー) '(太郎 ?y コーヒー) nil)
=> ((?y . 好き))
Lisp > (unify '(花子 好き 紅茶) '(花子 ?x ?y) nil)
=> ((?y . 紅茶) (?x . 好き))
match では第 2 引数にパターンを与えることはできませんが、unify はパターンでもかまいません。unify は match と同様に、成功した場合は束縛リストを返し、失敗した場合は fail を返します。
次は、ユニフィケーションの特徴的な例を示しましょう。
(unify '(花子 ?x ?y) '(花子 ?a ?b) nil)
=> ((?y . ?b) (?x . ?a))
(unify '(花子 ?x ?y) '(花子 ?x ?y) nil)
=> ((?y . ?y) (?x . ?x))
ユニフィケーションでは、パターン変数の値がパターン変数になることもあります。最後の例のように、自分自身が値となる場合もあります。このような場合でもユニフィケーションは成功するのです。
それでは unify を作っていきましょう。処理は match とほぼ同じですが、第 2 引数にもパターン変数が含まれるため、その処理を追加することになります。
| List 1 : ユニフィケーション |
|---|
(defun unify (pattern datum binding)
(cond ((variablep pattern)
(unify-variable pattern datum binding))
((variablep datum)
(unify-variable datum pattern binding))
((and (atom pattern) (atom datum))
(unify-atoms pattern datum binding))
((and (consp pattern) (consp datum))
(unify-pieces pattern datum binding))
(t 'fail)))
|
引数 datum がパターン変数かチェックする処理を追加しています。unify-atoms と unify-pieces は match を unify に置き換えただけで、match-atoms と match-pieces と同じです。
| List 2 : アトムとリストのユニフィケーション |
|---|
; アトムとのユニフィケーション
(defun unify-atoms (pattern datum binding)
(if (equal pattern datum) binding 'fail))
; リストのユニフィケーション
(defun unify-pieces (pattern datum binding)
(let ((result (unify (car pattern) (car datum) binding)))
(if (eq result 'fail)
'fail
(unify (cdr pattern) (cdr datum) result))))
|
次は、パターン変数とのユニフィケーションを行う unify-variable を作ります。unify-variable は match-variable と処理が異なる箇所があります。ユニフィケーションの場合、パターン変数とパターン変数は一致しますが、パターン変数とそれと同じパターン変数を含むパターンとは一致しないからです。次の例を見てください。
(unify '(太郎 好き ?x) '(太郎 好き (コーヒー ブラック)) nil)
=> ((?x コーヒー ブラック))
(unify '(太郎 好き (コーヒー ?x)) '(太郎 好き (コーヒー ブラック)) nil)
=> ((?x . ブラック))
(unify '(太郎 好き ?x) '(太郎 好き (コーヒー ?x)) nil)
=> fail
コーヒーの種類をリストで表すことにしました。最初の例では、?x は (コーヒー ブラック) となります。2 番目の例では、?x はブラックとなり、コーヒーの種類を求めることができます。
それでは、最後の例はどうなるのでしょうか。?x と (コーヒー ?x) を照合させることになります。この場合、最初の ?x は太郎が好きなものを表しているのに、次の ?x はコーヒーの種類を表すことになり矛盾してしまいます。したがって、?x と (コーヒー ?x) は不一致と判定しなくてはいけないのです。
それでは unify-variable を作りましょう。パターン変数と値を束縛リストに追加するときに、値の中に同じパターン変数がないことを確認します。この処理を関数 insidep で行います。
| List 3 : パターン変数とのユニフィケーション |
|---|
(defun unify-variable (pattern datum binding)
(let ((value (assoc pattern binding)))
(if (and value
(not (eq pattern (cdr value))))
(unify (cdr value) datum binding)
(if (insidep pattern datum binding)
'fail
(add-binding pattern datum binding)))))
|
実は、match-varibale との違いがもうひとつあります。ユニフィケーションの場合、同じパターン変数同士の照合は成功するので、束縛リストの中には、たとえば (?x . ?x) というドット対が含まれることがあります。このため、束縛リストから変数の値を探し、それを使って単純に unify を再帰呼び出しすると困ることが起こるのです。?x の値は ?x ですから、同じことをずっと繰り返すことになり、再帰呼び出しが停止しないのです。これを回避するために、最初の if でパターン変数とその値が異なることを確認しています。
そして、束縛リストにパターン変数と値を追加する前に関数 insidep を呼び出して、同じパターン変数が値の中で使われていないかチェックします。それでは insidep を作りましょう。
| List 4 : 同じパターン変数が含まれているか |
|---|
(defun insidep (var datum binding)
(unless (eq var datum)
(inside-sub-p var datum binding)))
|
insidep は引数 datum (パターン変数の値) に引数 var (パターン変数) が含まれていれば t を返し、そうでなければ nil を返します。実際の処理は関数 inside-sub-p で行います。ユニフィケーションは同じパターン変数の照合であれば成功するので、var と datum が同じパターン変数であれば nil を返します。
| List 5 : insidep 本体 |
|---|
(defun inside-sub-p (var datum binding)
(cond ((eq var datum) t)
((atom datum) nil)
((variablep datum)
(let ((value (assoc datum binding)))
(if value
(inside-sub-p var (cdr value) binding))))
(t
(or (inside-sub-p var (car datum) binding)
(inside-sub-p var (cdr datum) binding)))))
|
inside-sub-p はリストを car と cdr で分解しながら、パターン変数 var が含まれているかチェックします。最初に var と datum が等しいか eq でチェックします。結果が真であればデータの中に同じパターン変数を見つけたので t を返します。
次に、datum がアトムであれば、これ以上分解できないので nil を返します。datum がパターン変数の場合は、その値に var が含まれているかチェックします。assoc で束縛リストから datum を探索し、値が見つかれば inside-sub-p を再帰呼び出しします。そうでなければ nil を返します。
それ以外の場合は datum はリストなので、car と cdr でリストを分解して inside-sub-p を再帰呼び出しします。変数 var が見つかったら探索を中断して t を返せばいいので、or を使っていることに注意してください。つまり、CAR 部を調べてた結果が t ならば or は t を返しますし、nil であれば次の CDR 部の探索が行われます。
これでプログラムは完成です。実際にプログラムを動かして、いろいろ試してみてくださいね。
束縛リストによる管理方法は、リスト処理が得意な Lisp でよく使われる方法ですが、ここでもうひとつ別の方法を紹介しましょう。それはパターン変数を表すシンボルに値を格納する方法です。Lisp のシンボルは値を格納できますが、その機能はレキシカル変数とスペシャル変数に分かれます。今回の方法では、シンボルをスペシャル変数として使用します。
Common Lisp にはスペシャル変数の値を操作する関数が用意されています。次の図を見てください。
| 図 1 : スペシャル変数の操作関数 |
|---|
┌──シンボル──┐ set
boundp ←──│ スペシャル変数 │←─── data
(束縛チェック) └────────┘ ↑
↑ │ symbol-value │
│ └────────┘
│
makunbound (未束縛にする)
|
スペシャル変数には値がセットされていない場合があります。このとき、変数にアクセスするとエラーが発生します。シンボルがスペシャル変数の値を持っているか、つまり束縛されているかチェックする関数が boundp です。スペシャル変数の値を持たないようにする、つまり未束縛状態にする関数が makunbound です。値をセットする関数が set で、値を取り出す関数が symbol-value です。それでは、詳しく説明しましょう。
boundp symbol
makunbound symbol
boundp は symbol のスペシャル変数が値を持っていれば t を返し、そうでなければ nil を返します。makunbound は symbol のスペシャル変数を未束縛にします。スペシャル変数は値を持たなくなるので、そのシンボルを評価するとエラーになります。makunbound は未束縛にしたシンボルを返します。簡単な使用例を示しましょう。
(boundp 'a) => nil
(setq a 10) => 10
(boundp 'a) => t
(makunbound 'a) => a
(boundp 'a) => nil
シンボル a には値がセットされていません。ここで setq で a に 10 をセットします。a はレキシカル変数ではないので、スペシャル変数に値がセットされます。したがって boundp で a を調べると t を返します。makubound で a を未束縛状態にすると boundp は nil を返します。
set symbol value
symbol-value symbol
set は引数 symbol のスペシャル変数の値を value に変更します。set は関数なので symbol は評価されることに注意してください。評価結果がシンボルでなければエラーとなります。set はレキシカル変数の値を変更できません。set は value を返します。
symbol-value は symbol のスペシャル変数の値を取り出します。set と同じく、レキシカル変数にはアクセスできません。簡単な使用例を示しましょう。
(set 'a 10) => 10
(let ((a 100))
(print (symbol-value 'a))
(set 'a 20)
(print a))
10
100
a => 20
まず set でシンボル a のスペシャル変数に 10 をセットします。次に、let でレキシカル変数 a を 100 に設定します。symbol-value で a の値を取り出すと、スペシャル変数の値 10 となります。次に、set で a の値を 20 に変更します。この場合、スペシャル変数の値を変更するので、a の値を print しても 100 のままです。let の実行後、a を表示すると 20 に変更されています。
ここで注意点がひとつあります。今まで説明した set や symbol-value の動作は、変数がレキシカルスコープで管理されていることが前提です。たとえば、defvar で宣言された変数はダイナミックスコープで管理されますが、この場合 set や symbol-value は今までの説明とは異なる動作になります。スコープの違いに十分注意してください。
パターンマッチングの変数管理にスペシャル変数を使う場合、束縛・未束縛の状態をそのままパターン変数に当てはめることができるので便利なのです。ただし、スペシャル変数の値を変更するとその影響はずっと残るので、パターンマッチング終了後は未束縛状態に戻しておく必要があります。したがって、連想リストの場合と同じように、ユニフィケーションが成功したときは束縛した変数のリストを返し、失敗したときは fail を返すことにします。
それでは、スペシャル変数を使った管理方法でユニフィケーションを実現してみましょう。まず、パターン変数を束縛する add-binding から修正します。
| List 6 : 変数に値をセットする |
|---|
(defun add-binding (var datum binding) (set var datum) (cons var binding)) |
値のセットは set を使えば簡単です。var にセットされているシンボルのスペシャル変数に datum の値がセットされます。最後に変数 var を binding に追加します。
次は、束縛された変数をクリアする関数 clear-binding を作ります。
| List 7 : 変数をクリアして 'fail を返す |
|---|
(defun clear-binding (binding)
(if (consp binding)
(map nil #'makunbound binding))
'fail)
|
binding がリストであれば、そこに格納されている変数を makunbound で未束縛にします。列関数 map を使って、各要素に makunbound を適用しています。最後に fail を返します。
それでは、ユニフィケーションを修正しましょう。不一致と判定する処理で、今まで束縛されたパターン変数を未束縛にするため、clear-binding を呼び出すようにします。最初は unify です。
| List 8 : ユニフィケーション |
|---|
(defun unify (pattern datum binding)
(cond ((variablep pattern)
(unify-variable pattern datum binding))
((variablep datum)
(unify-variable datum pattern binding))
((and (atom pattern) (atom datum))
(unify-atoms pattern datum binding))
((and (consp pattern) (consp datum))
(unify-pieces pattern datum binding))
(t (clear-binding binding))))
|
最後の節で fail を返しますが、ここで clear-binding を呼び出して変数束縛をクリアします。
| List 9 : アトムとのユニフィケーション |
|---|
(defun unify-atoms (pattern datum binding)
(if (equal pattern datum)
binding
(clear-binding binding)))
|
unify-atoms は pattern と datum が等しくない場合、clear-binding を呼び出し、変数を未束縛にしてから fail を返します。
リストのユニフィケーション unify-pieces は修正の必要はありません。次は unify-variable を変更します。
| List 10 : パターン変数とのユニフィケーション |
|---|
(defun unify-variable (var datum binding)
(if (and (boundp var)
(not (eq (symbol-value var) var)))
(unify (symbol-value var) datum binding)
(if (insidep var datum binding)
(clear-binding binding)
(add-binding var datum binding))))
|
unify-varibale はパターン変数の値を求める処理を修正します。まず boundp でスペシャル変数に値がセットされていることを確認し、次にその値が自分自身でないことを確認します。変数が束縛されていれば、値を取り出して再度 unify を呼び出します。未束縛の場合は、変数 var が datum 内で使われていないことを確認します。使われていれば clear-binding で束縛をクリアして failを返します。
insidep はそのままでいいのですが、inside-sub-p は修正が必要です。
| List 11 : insidep 本体 |
|---|
(defun inside-sub-p (var datum binding)
(cond ((eq var datum) t)
((atom datum) nil)
((variablep datum)
(if (and (boundp datum)
(not (eq (symbol-value datum) datum)))
(inside-sub-p var (symbol-value datum) binding)))
(t
(or (inside-sub-p var (car datum) binding)
(inside-sub-p var (cdr datum) binding)))))
|
datum がパターン変数の場合、値を取り出す処理を symbol-value に変更します。
これで修正は終わりましたが、このままだと unify は変数リストを返すだけで、その値を見ることができません。そこで、パターン変数から値を求める関数を作ります。
| List 12 : パターン変数の値を求める |
|---|
(defun variable-value (var)
(let (value)
(loop
(unless (boundp var) (return var))
(setq value (symbol-value var))
(cond
((eq var value)
(return value))
((variablep value)
(setq var value))
((consp value)
(return (replace-variable value)))
(t (return value))))))
|
variable-value は変数のリンケージをたどって値を求めます。この処理は再帰定義を使わなくても、繰り返しで実現できます。まず boundp で変数 var が束縛されているかチェックします。未束縛であれば、その変数をそのまま返します。ユニフィケーションはパターン変数同士の照合が可能なので、ある変数が未束縛のままということもあるのです。
次に symbol-value で var の値を取り出して、その値をチェックします。もし、var と value が同じシンボルであれば、自分自身が値として格納されています。この場合は、そのシンボルを return で返します。次に value がパターン変数の場合は、value を var にセットして繰り返しを続行します。これで、変数間のリンケージをひとつたどったことになります。
value がリストの場合は、その中にある変数を置換してその結果を return で返します。この処理を関数 replace-variable で行います。最後の節では value をそのまま return で返すだけです。
次は、リスト内のパターン変数をその値で置換する関数 replace-variable を作ります。
| List 13 : パターン変数を置換する |
|---|
(defun replace-variable (pattern)
(cond
((variablep pattern)
(variable-value pattern))
((atom pattern) pattern)
(t
(cons (replace-variable (car pattern))
(replace-variable (cdr pattern))))))
|
replace-variable は再帰を使えば簡単に作れます。pattern がリストの場合は car と cdr で分解し、repalce-varibale を再帰呼び出しします。そして、その返り値を cons で組み立てればよいわけです。
再帰呼び出しの停止条件は pattern が atom の場合ですが、その前に pattern がパターン変数かチェックします。その場合は variable-value で値を求め、その結果を返すようにします。これで、変数をその値に置き換えることができます。
最後に、ユニフィケーションを実行して変数の値を表示する関数 exec-unify を作ります。
| List 14 : ユニフィケーションの実行 |
|---|
(defun exec-unify(pattern datum)
(let ((result (unify pattern datum nil)))
(when (consp result)
(dolist (var result)
(format t "~S = ~S~%" var (variable-value var)))
(clear-binding result))
result))
|
unify で引数 pattern と datum を照合し、その結果を変数 result にセットします。result がリストならばパターン変数に値がセットされています。result に格納された変数を dolist でひとつずつ取り出し、値を variable-value で求めて format で表示します。そして、clear-binding でパターン変数を未束縛の状態に戻してから result を返します。
これでプログラムは完成です。簡単な実行例を示しましょう。
(exec-unify '(a b c) '(a b c))
=> nil
(exec-unify '(a b c) '(a b d))
=> fail
(exec-unify '(a b c) '(?x ?y ?z))
?z = c
?y = b
?x = a
=> (?z ?y ?x)
皆さんも実際にプログラムを実行して、動作を確認してみてくださいね。
;
; unify.l : ユニフィケーション
;
; Copyright (C) 2003 Makoto Hiroi
;
;
; 要素はパターン変数か
;
(defun variablep (pattern)
(and (symbolp pattern)
(char= #\? (char (string pattern) 0))))
;
; ユニフィケーション
;
(defun unify (pattern datum binding)
(cond ((variablep pattern)
(unify-variable pattern datum binding))
((variablep datum)
(unify-variable datum pattern binding))
((and (atom pattern) (atom datum))
(unify-atoms pattern datum binding))
((and (consp pattern) (consp datum))
(unify-pieces pattern datum binding))
(t 'fail)))
;
; アトムとのユニフィケーション
;
(defun unify-atoms (pattern datum binding)
(if (equal pattern datum) binding 'fail))
;
; リストのユニフィケーション
;
(defun unify-pieces (pattern datum binding)
(let ((result (unify (car pattern) (car datum) binding)))
(if (eq result 'fail)
'fail
(unify (cdr pattern) (cdr datum) result))))
;
; 変数とのユニフィケーション
;
(defun unify-variable (pattern datum binding)
(let ((value (assoc pattern binding)))
(if (and value
(not (eq pattern (cdr value))))
(unify (cdr value) datum binding)
(if (insidep pattern datum binding)
'fail
(add-binding pattern datum binding)))))
;
; datum の中に var があるか
;
(defun insidep (var datum binding)
(unless (eq var datum)
(inside-sub-p var datum binding)))
;
; insidep 本体
;
(defun inside-sub-p (var datum binding)
(cond ((eq var datum) t)
((atom datum) nil)
((variablep datum)
(let ((value (assoc datum binding)))
(if value
(inside-sub-p var (cdr value) binding))))
(t
(or (inside-sub-p var (car datum) binding)
(inside-sub-p var (cdr datum) binding)))))
;
; unify.l : スペシャル変数を使ったユニフィケーション
;
; Copyright (C) 2003 Makoto Hiroi
;
;
; 要素はパターン変数か
;
(defun variablep (pattern)
(and (symbolp pattern)
(char= #\? (char (string pattern) 0))))
;
; ユニフィケーション
;
(defun unify (pattern datum binding)
(cond ((variablep pattern)
(unify-variable pattern datum binding))
((variablep datum)
(unify-variable datum pattern binding))
((and (atom pattern) (atom datum))
(unify-atoms pattern datum binding))
((and (consp pattern) (consp datum))
(unify-pieces pattern datum binding))
(t (clear-binding binding))))
;
; アトムとのユニフィケーション
;
(defun unify-atoms (pattern datum binding)
(if (equal pattern datum)
binding
(clear-binding binding)))
;
; リストのユニフィケーション
;
(defun unify-pieces (pattern datum binding)
(let ((result (unify (car pattern) (car datum) binding)))
(if (eq result 'fail)
'fail
(unify (cdr pattern) (cdr datum) result))))
;
; 変数とのユニフィケーション
;
(defun unify-variable (var datum binding)
(if (and (boundp var)
(not (eq (symbol-value var) var)))
(unify (symbol-value var) datum binding)
(if (insidep var datum binding)
(clear-binding binding)
(add-binding var datum binding))))
;
; datum の中に var(変数)があるか
;
(defun insidep (var datum binding)
(unless (eq var datum)
(inside-sub-p var datum binding)))
;
; insidep 本体
;
(defun inside-sub-p (var datum binding)
(cond ((eq var datum) t)
((atom datum) nil)
((variablep datum)
(if (and (boundp datum)
(not (eq (symbol-value datum) datum)))
(inside-sub-p var (symbol-value datum) binding)))
(t
(or (inside-sub-p var (car datum) binding)
(inside-sub-p var (cdr datum) binding)))))
;
; 変数を置換する
;
(defun replace-variable (pattern)
(cond
((variablep pattern)
(variable-value pattern))
((atom pattern) pattern)
(t
(cons (replace-variable (car pattern))
(replace-variable (cdr pattern))))))
;
; 変数値を求める
;
(defun variable-value (var)
(let (value)
(loop
(unless (boundp var) (return var)) ; 未束縛
(setq value (symbol-value var)) ; スペシャル変数を取り出す
(cond
((eq var value)
(return value)) ; 自分自身が入っている
((variablep value)
(setq var value))
((consp value) ; リストの中に変数があるかもしれないので置換する
(return (replace-variable value)))
(t (return value))))))
;
; 変数値をセットする
;
(defun add-binding (var datum binding)
(set var datum)
(cons var binding))
;
; 変数をクリアして 'fail を返す
;
(defun clear-binding (binding)
(if (consp binding)
(map nil #'makunbound binding))
'fail)
;
; ユニフィケーションの実行
;
(defun exec-unify (pattern datum)
(let ((result (unify pattern datum nil)))
(when (consp result)
(dolist (var result)
(format t "~S = ~S~%" var (variable-value var)))
(clear-binding result))
result))