McCarthy の非決定性オペレータ amb [cite{jmc:amb}, cite{wc:amb}, cite{zmc:amb}] は
Lisp 自身と同じくらい古いものですが、Lisp にはありません。amb は
０個あるいはそれ以上の式を引数としてとり、それらの、非決定的な
(あるいは「あいまいな」)な選択を作ります。プログラムを意味のあるものに
収束させるこれらの選択を好んでつかいます。ここで、
曖昧選択の深さ優先選択をつかい、他の選択肢を探索するための
バックトラックに Scheme の制御オペレータ call/cc を使う
amb の Scheme への埋め込みについて検討しましょう。
結果は、拡張言語にたよることなく、Scheme で直接書けるような
探索問題の分野で使用できるエレガントなバックトラッキング戦略が
できあがります。この埋め込みは Prolog 流の論理プログラミング
[cite{logick}, cite{mf:prolog}] を想起させますが、これはより寛大なものです。
というのも、このオペレータは Scheme の真理値オペレータにたいへん
似ており、利用にあたっては、とくべつな文脈を必要とせず、
論理変数やユニフィケーションというような言語上の基盤に依存しません。
ambの解説
amb のとっつきやすい解説とたくさんの使用例は、かの最高の
Scheme の教科書 SICP [cite{sicp}] にあります。非公式には、
amb はゼロ個以上の式をとり、そのうちのひとつの値を
非決定的に返します。なので、
(amb 1 2)
は 1 あるいは 2 に評価されます。
引数の式なしで呼ばれた amb は返すべき値をもちません。これは
失敗と看倣されます。なので、
(amb) -->ERROR!!! amb tree exhausted
です(エラーメッセージをどうするかはあとで検討します)。
もし、amb は少くとも一つの部分式が収束するなら、値をひとつ返さ
なければなりません。つまり、このときは失敗にはなりません。
したがって
(amb 1 (amb))
と
(amb (amb) 1)
とはともに 1 を返します。
あきらかに、amb は単に最初の部分式を返すわけにはいきません。
あらゆる可能性があるとするなら、失敗ではない値を返さねば
ならないからです。しかし、かならずしも全部の可能性というわけでは
ありません。収束の偏りは amb の部分式の局所的な選択よりも
強いものです。さらに、amb は、プログラム全体を収束
させるようなまさにその収束値を返すべきです。外延的な言い方
をすると、amb は 天使のオペレータです。
たとえば、
(amb #f #t)
は #f か #t のどちらかを返すことができますが、
次のようなプログラム
(if (amb #f #t) 1 (amb))
では、最初の amb-式は #t を返さなければなりません。
もし、#f を返すと、if の「else」の枝が選択され、プログラム
全体は失敗してしまうからです。
amb の実装
ここでの amb の実装では、amb の部分式を左から右へ選ぶように
しましょう。つまり、最初の部分式が選択して、もし、それが、全体を
失敗に導いたなら、二番目を選択して…、というようにします。
プログラムの制御フローの後のほうにある amb の出現は、
手前の amb にバックトラックする前に別の選択肢を探します。
いいかえれば、amb の選択木を深さ優先探索します。
失敗にあたったら、必ずその木のさらに別の選択のある直近のノードに
バックトラックします。(これを時間順バックトラックといいます。)
まず、ベースになる失敗継続を設定するための機構を定義します。
(define amb-fail '*) (define initialize-amb-fail (lambda () (set! amb-fail (lambda () (error "amb tree exhausted"))))) (initialize-amb-fail)
amb が失敗したときに、これはそのときに amb-fail に
束縛されている継続を呼び出します。
amb を不定個の部分式を受け入れるマクロとして定義します。
(define-macro amb (lambda alts... `(let ((+prev-amb-fail amb-fail)) (call/cc (lambda (+sk) ,@(map (lambda (alt) `(call/cc (lambda (+fk) (set! amb-fail (lambda () (set! amb-fail +prev-amb-fail) (+fk 'fail))) (+sk ,alt)))) alts...) (+prev-amb-fail))))))
amb の呼び出しは、まず、エントリ時点で最新の
amb-fail の値を +prev-amb-fail にしまっておきます。
それは、amb-fail 変数はいろいろな選択肢を試したときの
失敗継続がセットされるからです。
それから、amb の エントリ継続を +skに捕捉します。
そうすると、選択肢の一つが、失敗ではない値に評価されたら、
ただちに、その amb を抜け出すことができます。
それぞれの選択肢 alt は順(これは、Scheme での暗黙の
begin のならび)で試されます。
まず、現在の継続を +fk で捕捉し、これを手続きで包み、
amb-fail をこの手続きにセットします。このあと選択肢は、
(+sk alt) として評価されます。もし、 alt が失敗なしに
評価されたら、その返り値は、継続 +sk に渡たり、即座に
amb の呼び出しから脱出します。もし、alt が失敗したら
amb-fail が呼び出されます。amb-fail が最初にすべき
ことは amb-fail をこれがエントリ時に持っていた値にセット
しなおすことです。それから失敗継続 +fk を呼び、これが
次の選択肢となり、あれば、それを試します。
もし、すべての選択肢が失敗すれば、+prev-amb-fail に格納
しておいた amb エントリ時の amb-fail が呼ばれます。
amb を使う1 から 10 までの数字を選ぶとすると、次のように書けます。
(amb 1 2 3 4 5 6 7 8 9 10)
実際のところ、プログラムとしては 1 になるでしょうが、 それはコンテキストによります。列挙されている数のどれもが 可能性があります。
手続き number-between は与えられた lo と hi の間の数
(両端を含む)を生成するより抽象的な方法です。
(define number-between (lambda (lo hi) (let loop ((i lo)) (if (> i hi) (amb) (amb i (loop (+ i 1)))))))
それゆえ、(number-between 1 6) は最初は 1 を返します。
これが失敗すれば、loop が繰り返されて、2 が生成されます。
それも失敗すれば、3 が得られます。などなど、6 まで続きます。
6 の後、loop は 7 で呼ばれますが、これは 6 を越えているので
q(amb) が呼ばれ、これが最終の失敗となります。((amb)) は
それじしんで失敗を生成することを思い出してください。)
ここにいたって、(number-between 1 6) を含むプログラムは
時間的に直前の amb 呼び出しにバックトラックして
そのよびびだしを他の方法で満すかどうかを試します。
(amb) の保証された失敗はプログラムの表明に使います。
(define assert (lambda (pred) (if (not pred) (amb))))
(assert pred) の呼び出しは pred が真であるという表明をする
ものです。もし真でなければ、現在の amb 選択肢が失敗します。
1
これは、assert をつかって、引数の hi 以下の素数を生成する
手続きです。
(define gen-prime (lambda (hi) (let ((i (number-between 2 hi))) (assert (prime? i)) i)))
これは非常に単純ですが、どんな数(たとえば 20)で呼ばれても、 あまり面白くない最初の解、つまり 2 を生成します。
欲しいのは、すべての解であって、最初の解だけではないのです。 いまの場合には 20 以下のすべての素数が欲しいわけです。ひとつの 方法は明示的に、最初の解を生成したあとののこりの失敗継続を呼びだす ことです。つまり、
(amb) => 3
とします。これではまだ別の失敗継続が残っていますので、再びそれを 呼び出せば、さらに別の解がでてきます。
(amb) => 5
この方法の問題は、プログラムを最初に Scheme のプロンプトから
呼び出し、そのあとで、また、Scheme のプロンプトから amb を
呼び出して一連の解を得るということである。実際、いろいろなプログラム
(いくつかというのは前もってわからない！)をつかうわけで、一つ前の
プログラムから次へと情報を持ち越すわけです。このようにせずに、
どのようなコンテキストででも呼び出し可能なフォームの値として、
これらの解を返せればいいわけです。これを実現するために、
bag-of マクロをを定義します。これは、引数の成功したインスタンス
をすべて返すものです(もし、引数がどれも成功しなければ、空リストを
返します)。そうすると、次のように書くことができて、
(bag-of (gen-prime 20))
これは
(2 3 5 7 11 13 17 19)
を返します。この bag-of マクロは以下のように定義します。
(define-macro bag-of (lambda (e) `(let ((+prev-amb-fail amb-fail) (+results '())) (if (call/cc (lambda (+k) (set! amb-fail (lambda () (+k #f))) (let ((+v ,e)) (set! +results (cons +v +results)) (+k #t)))) (amb-fail)) (set! amb-fail +prev-amb-fail) (reverse! +results))))
bag-of は最初に、エントリ時の amb-fail を保存します。
amb-fail を局所継続 +k を if-テストの中で生成するように
再定義します。テストの内側で、bag-of の引数 e が評価されます。
e が成功したら、その結果は +results というリストに集められます。
そして、局所継続は、値 #t で呼ばれます。これにより、if-テストは
成功し、e は次のバックトラックポイントから再試行されます。
さらなる e の結果が、この方法で得られ、それらがすべて +results
に集められます。
最終的に e が失敗したときに、ベースの amb-fail が呼ばれます。
単に、局所継続を値 #f で呼ぶだけです。これは if に渡された
制御をプッシュします。amb-fail をエントリ前の値に戻し、
+result を返します。(reverse! は結果を生成された順にするだけです。)
バックトラックと連動した深さ優先探索のパワーは論理パズルを解いてみると
明かになります。これらの問題は、手続き的に解くのは非常に難しいですが、
amb をつかって、簡潔に、宣言的に解けます。パズルを解く、楽しみを
うばわれることはありません。
カロタンは奇妙な癖のある種族です。2 男は常に真実を語り、女はいちどきに 2 つの真実は言わない あるいは、いちどきに 2 つの嘘は言わないというものです。
ある人類学者(彼をウォルフと呼びましょう)が彼らの研究を始めました。 ウォルフはまだ、カロタンの言葉を知りません。ある日、カロタンの カップル(異性)とその子どものキビと出会いました。ウォルフはキビに 「きみは男の子？」とたずねました。キビはカロタン語で答えたので、 ウォルフには分りませんでした。
ウォルフは両親(英語を知っている)に説明を求めました。 ひとりが、「キビは、自分は男の子だといっている」と言い もうひとりが、「キビは女の子。キビは嘘をついた」と付け加えました。
この両親の性別とキビの性別をあててください。
解は変数の集りを導入することにあります。値の選択を可能にし
その上の条件を assert 式の並びとして列挙することです。
変数 parent1、parent2 および kibi は両親(出てきた順)と
キビの性別です。kibi-self-desc は キビが自分で言った(カロタン語で)
自分の性別、kibi-lied? はキビの言ったことが嘘かどうかの真理値です。
(define solve-kalotan-puzzle (lambda () (let ((parent1 (amb 'm 'f)) (parent2 (amb 'm 'f)) (kibi (amb 'm 'f)) (kibi-self-desc (amb 'm 'f)) (kibi-lied? (amb #t #f))) (assert (distinct? (list parent1 parent2))) (assert (if (eqv? kibi 'm) (not kibi-lied?))) (assert (if kibi-lied? (xor (and (eqv? kibi-self-desc 'm) (eqv? kibi 'f)) (and (eqv? kibi-self-desc 'f) (eqv? kibi 'm))))) (assert (if (not kibi-lied?) (xor (and (eqv? kibi-self-desc 'm) (eqv? kibi 'm)) (and (eqv? kibi-self-desc 'f) (eqv? kibi 'f))))) (assert (if (eqv? parent1 'm) (and (eqv? kibi-self-desc 'm) (xor (and (eqv? kibi 'f) (eqv? kibi-lied? #f)) (and (eqv? kibi 'm) (eqv? kibi-lied? #t)))))) (assert (if (eqv? parent1 'f) (and (eqv? kibi 'f) (eqv? kibi-lied? #t)))) (list parent1 parent2 kibi))))
ヘルパ手続きについて：distinct? は引数のリストのすべての
要素が別々のものであれば真を返し、そうでなければ偽を返します。
手続き xor は二つの引数の一方のみ真であるとき真を返し、
そうでなければ偽を返します。
(solve-kalotan-puzzle) を入力すればパズルが解けます。
地図を塗り分ける — すなわち、隣国とは別の色になるよう塗り分けるには 4 色あればたりるというのは、長く知られ(証明されたのは 1976年 [cite{4cp}]になってのこと)ていました。実際にどのように塗り分け るのかは、ちょっとした仕事です。以下のプログラムは、非決定性 プログラミングがどのように役立つかを示しています。
以下のプログラムは西ヨーロッパの地図を塗り分ける問題を解くものです。 問題と Prolog での解答は『Prolog の技芸』[cite{aop}] にあります。 (ここでの解法とこの本での解法を比較するのは、ためになります。)
手続き choose-color は非決定的に 4つの色のひとつを返します。
(define choose-color (lambda () (amb 'red 'yellow 'blue 'white)))
ここの解法では、それぞれの国をデータ構造として生成します。
このデータ構造は 3 つの要素からなるリストで、第一要素は
国名、第二要素は割り当てられた色、第三要素は隣国の色です。
その国の色をあらわす変数にはその国のなまえの頭文字を使います。
3
たとえば、ベルギーのリストは、(list 'belgium b (list f h l g))
です。これは、問題文によれば、ベルギーの隣国は、フランス、オランダ、
ルクセンブルク、ドイツだからです。
それぞれの国のリストができたら、これらが満すべき(唯一！)の条件を 表明します。つまり、隣国と同じ色であってはいけないというものです。 言い換えれば、すべての国のリストについての第二要素は第三要素の メンバーであってはならないということです。
(define color-europe (lambda () ;国ごとの色の選択肢 (let ((p (choose-color)) ;Portugal (e (choose-color)) ;Spain (f (choose-color)) ;France (b (choose-color)) ;Belgium (h (choose-color)) ;Holland (g (choose-color)) ;Germany (l (choose-color)) ;Luxemb (i (choose-color)) ;Italy (s (choose-color)) ;Switz (a (choose-color)) ;Austria ) ;各国ごとに隣接リストを構築する ;第一要素は国名 ;第二要素はその国の色 ;第三要素は隣国の色のリスト (let ((portugal (list 'portugal p (list e))) (spain (list 'spain e (list f p))) (france (list 'france f (list e i s b g l))) (belgium (list 'belgium b (list f h l g))) (holland (list 'holland h (list b g))) (germany (list 'germany g (list f a s h b l))) (luxembourg (list 'luxembourg l (list f b g))) (italy (list 'italy i (list f a s))) (switzerland (list 'switzerland s (list f i a g))) (austria (list 'austria a (list i s g)))) (let ((countries (list portugal spain france belgium holland germany luxembourg italy switzerland austria))) ;国の色は ;隣国の色の ;どれであってもいけない (for-each (lambda (c) (assert (not (memq (cadr c) (caddr c))))) countries) ;色の割り当ての出力 (for-each (lambda (c) (display (car c)) (display " ") (display (cadr c)) (newline)) countries))))))
(color-europe) と入力すれば、色の割り当てが得られます。
1 SICP ではこの手続きは require という名前です。ここでは、
非公式ですが、よくある require の別の使い方との混乱を避ける
ために assert という識別子を使います。require は必要なときに
モジュールをロードするオペレータとしてよく使います。
2 このパズルはハンター[cite{hunter}]に よるものです。
3 スペイン(España) は e でこれはスイスとぶつからないようにです。