今回は、地図上の A 地点から B 地点までの道順を求める、といった「経路の探索」と呼ばれる問題を取り上げます。「探索」にはいろいろな種類があります。「8 クイーン」のようなパズルの解法も、あらゆる可能性の中から正解に行き着く手順を探すことですから、探索の一つと考えることができます。そして、探索でよく用いられる最も基本的な方法が「バックトラック」なのです。もちろん、経路の探索もバックトラックで解くことができます。
このほかに、もう一つ基本的な方法として「幅優先探索」があります。バックトラックの場合、失敗したら後戻りして別の道を選び直しますが、幅優先探索の場合は、全ての経路について並行に探索を進めていきます。幅優先探索は最短手順を求めるのに適したアルゴリズムですが、問題によっては必要となるメモリの量がとても多くなり、幅優先探索を使用することができない場合があります。このような場合、「反復深化」という方法を使うと、多少時間はかかりますが、少ないメモリで最短手順を求めることができます。今回はこの 3 つの方法で経路を求めてみましょう。
まず最初に「グラフ (graph)」というデータ構造を説明します。一般にグラフというと、 円グラフや折れ線グラフといった図表を思い出す人が多いと思います。数学の「グラフ理論」では、いくつかの点とそれを結ぶ線でできた図形を「グラフ」といいます。次の図を見てください。
頂点 辺
↓ ↓
●─────────●
│ │
│ │
│ │
●─────────●
図 : グラフの例
上図に示すように、グラフは点とそれを接続する線から構成されています。点のことを「頂点 (vertex)」や「節点 (node)」と呼び、線のことを「辺 (edge)」や「弧 (arc)」と呼びます。また、グラフには 2 種類あって、辺に向きの無いグラフを「無向グラフ」といい、辺に向きがあるグラフを「有向グラフ」といいます。有向グラフは一方通行の道と考えればいいでしょう。 次の図を見てください。
(1) Ａ──────────→Ｂ 有向グラフ
(2) Ａ←─────────→Ｂ 無向グラフ
図 : 有向グラフと無向グラフ
たとえば、上図の (1) では A 地点から B 地点へ行くことができますが、一方通行のため B 地点から A 地点に戻ることはできません。これが有効グラフです。(2) の無効グラフでは、A 地点から B 地点へ行くことができるし、逆に B 地点から A 地点に戻ることもできます。
データ間のさまざまな関係を表す場合、グラフはとても役に立ちます。たとえば、下図のように経路をグラフで表すことができます。
Ｂ───Ｄ───Ｆ
／│ │
Ａ │ │
＼│ │
Ｃ───Ｅ───Ｇ
図 : 経路図
上図ではアルファベットで頂点を表しています。この例では経路をグラフで表していますが、このほかにもいろいろな問題をグラフで表現することができます。
グラフをプログラムする場合、よく使われる方法に「隣接行列」と「隣接リスト」があります。隣接行列は 2 次元配列で頂点の連結を表す方法です。頂点が N 個ある場合、隣接行列は N 行 N 列の行列で表すことができます。上の経路図を隣接行列で表すと次のようになります。
│A B C D E F G ─┼─────── A│0 1 1 0 0 0 0 B│1 0 1 1 0 0 0 C│1 1 0 0 1 0 0 D│0 1 0 0 1 1 0 E│0 0 1 1 0 0 1 F│0 0 0 1 0 0 0 G│0 0 0 0 1 0 0 図 : 隣接行列
A に接続している頂点は B と C なので、A 行の B と C に 1 をセットし、接続していない頂点には 0 をセットします。経路が一方通行ではない無向グラフの場合は、A 列の B と C にも 1 がセットされます。これを Common Lisp でプログラムすると、次のようになります。
リスト : 隣接行列
(defvar *adjacent*
#2A((0 1 1 0 0 0 0) ; A
(1 0 1 1 0 0 0) ; B
(1 1 0 0 1 0 0) ; C
(0 1 0 0 1 1 0) ; D
(0 0 1 1 0 0 1) ; E
(0 0 0 1 0 0 0) ; F
(0 0 0 0 1 0 0))) ; G
頂点 A から G を数値 0 から 6 に対応させるところがポイントです。隣接行列は 2 次元配列で表します。内容は上図の隣接行列と同じです。
隣接行列の欠点は、辺の数が少ない場合でも N 行 N 列の行列が必要になることです。つまり、ほとんどの要素が 0 になってしまい、メモリを浪費してしまうのです。この欠点を補う方法に隣接リストがあります。これはつながっている頂点をリストに格納する方法です。これを Common Lisp でプログラムすると次のようになります。
リスト : 隣接リスト
(defvar *adjacent*
#((1 2) ; A
(0 2 3) ; B
(0 1 4) ; C
(1 4 5) ; D
(2 3 6) ; E
(3) ; F
(1))) ; G
隣接行列と同様に、頂点 A から G を数値 0 から 6 に対応させます。この場合、ベクタの要素がリストになることに注意してください。
ところで、隣接リストにも欠点があります。たとえば、E と G が接続しているか調べるには、データを順番に調べていくしか方法がありません。このため、接続の判定に時間がかかることがあるのです。まあ、頂点に接続されている辺の数が少なければ、処理速度が極端に遅くなることはないでしょう。
ところで、Lisp でグラフをプログラムするのであれば、わざわざ頂点を数値に変換する必要はありません。頂点はシンボルで表せばいいのです。頂点と隣接リストの対応は連想リストを使うと簡単です。次のリストを見てください。
リスト : 連想リストによる隣接リストの表現
(defvar *adjacent*
'((A B C)
(B A C D)
(C A B E)
(D B E F)
(E C D G)
(F D)
(G E)))
グラフを連想リストで表現する場合、キーが頂点を表すシンボルでデータが隣接リストになります。そして、関数 assoc で頂点の隣接リストを求めることになります。次の例を見てください。
* (dolist (node '(a b c d e f g)) (print (cdr (assoc node *adjacent*)))) (B C) (A C D) (A B E) (B E F) (C D G) (D) (E) NIL
assoc で頂点 node を検索して cdr で隣接リストを取り出しています。
それではプログラムを作りましょう。今回は隣接リストを使って、A から G までの経路をバックトラックで求めます。経路図を再掲します。
Ｂ───Ｄ───Ｆ
／│ │
Ａ │ │
＼│ │
Ｃ───Ｅ───Ｇ
図 : 経路図
経路の表し方ですが、これはシンボルを並べたリストで表せばいいでしょう。たとえば、A 地点から G 地点までの経路は次のようになります。
A - C - E - G --> (A C E G) ==> (G E C A) ; 逆順で管理する
図 : 経路の管理方法
ただし、そのまま並べただけでは探索中の処理が面倒になります。というのは、経路 A - C を E へ延ばす場合、リスト (A C) の最後にシンボル E を追加しなければならないからです。リストの先頭にデータを追加することは cons を使って簡単にできますが、それ以外の場所にデータを追加するのはちょっと面倒です。そこで、経路を逆順に管理することにします。
バックトラックを再帰呼び出しで実現する場合、拙作のページ「順列と組み合わせ」で説明したように、「進む」ことを再帰呼び出しに対応させるのがポイントです。たとえば、経路を探索する関数を search としましょう。search は引数としてゴール地点と経路を受け取ることにします。最初は次のように呼び出します。
(search 'G '(A))
経路を逆順で表しているので、リストの先頭要素が現在地点 (経路の先端) を表わしていることに注意してください。そして、A から B へ進むにはリストの先頭に B を追加して search を再帰呼び出しします。
(search 'G '(A)) -- Call --> (search 'G '(B A))
これで A から B へ進むことができます。それでは、A に戻るにはどうしたらいいのでしょう。(search 'G '(B A)) は (search 'G '(A)) から呼び出されたので、(search 'G '(B A)) の実行を終了すれば呼び出し元である (search 'G '(A)) に戻ることができます。
(search 'G '(A)) -- Call --> (search 'G '(B A))
<-- Return --
つまり、関数の実行を終了すれば、ひとつ手前の地点にバックトラックできるのです。このように、再帰呼び出しを使うと、進むことと戻ることを関数呼び出しで簡単に実現することができます。プログラムは次のようになります。
リスト : 経路の探索 (1)
; 深さ優先探索
(defun depth-first-search (goal path)
(if (eq (car path) goal)
(print (reverse path))
(dolist (x (cdr (assoc (car path) *adjacent*)))
(unless (member x path)
(depth-first-search goal (cons x path))))))
経路図を表す隣接リストは連想リストで表すことにします。関数 depth-first-search の引数 GOAL がゴール地点、PATH が経路を表します。最初に、ゴールに到達したかチェックします。GOAL と同じシンボルであれば print で経路を表示します。経路は逆順になっているので、reverse で PATH を反転しています。そして、経路を求めたあとバックトラックすることにより、A から G までの経路をすべて求めることができます。
ゴールに到達していない場合は経路をのばして探索を進めます。このとき、節点 X が経路 PATH に含まれていないかチェックすることを忘れないで下さい。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールである G 地点にたどり着くことができなくなります。それから、PATH の先頭に X を追加して depth-first-search を再帰呼び出しします。
実際に depth-first-search を実行すると、次のような経路を表示します。
* (depth-first-search 'g '(a)) (A B C E G) (A B D E G) (A C B D E G) (A C E G) NIL
4 通りの経路を見つけることができました。バックトラックによる探索は経路を先へ先へ進めるので、「縦形探索」とか「深さ優先探索」と呼ばれています。このため、結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるには「幅優先探索」というアルゴリズムが適しています。
深さ優先探索は一つの経路を先へ先へと進めていくため、最初に見つかる経路が最短経路であるとは限りません。幅優先探索はすべての経路について平行に探索を進めていくため、最初に見つかる経路が最短経路となります。それでは、同じ経路図を使って幅優先探索を具体的に説明しましょう。
幅優先探索の様子を下図に示します。
(A) ─┬─ (A B) ─┬─ (A B C) ・・・・
│ └─ (A B D) ─┬─ (A B D F) 行き止まり
│ └─ (A B D E)
└─ (A C) ─┬─ (A C B) ・・・・
└─ (A C E) ─┬─ (A C E G) GOAL
└─ (A C E D)
（出発点） （２節点） （３節点） （４節点）
図 : 幅優先探索
まず、出発点 A から一つ進んだ経路 (2 節点) をすべて求めます。この場合は、(A B) と (A C) の 2 つあり、これをすべて記憶しておきます。次に、これらの経路から一つ進めた経路 (3 節点) をすべて求めます。経路 (A B) は (A B C) と (A B D) へ進めることができますね。ほかの経路 (A C) も同様に進めて、すべての経路を記憶します。あとはこの作業をゴールに達するまで繰り返せばいいのです。
上図では、4 節点の経路 (A C E G) でゴールに達していることがわかります。このように幅優先探索では、最初に見つかった経路が最短距離 (または最小手数) となるのです。この性質は、すべての経路を平行に進めていく探索順序から考えれば当然のことといえるでしょう。このことからバックトラックの縦形探索に対して、幅優先探索は「横形探索」と呼ばれます。このあとも探索を繰り返せばすべての経路を求めることができます。
完成までの最小手数を求めるパズルを解く場合、幅優先探索を使ってみるといいでしょう。ただし、探索を進めるにしたがって、記憶しておかなければならないデータの総数が爆発的に増加する、つまりメモリを大量消費することに注意してください。
上図の場合ではメモリを大量消費することはありませんが、問題によってはマシンに搭載されているメモリが不足するため、幅優先探索を実行できない場合もあるでしょう。したがって、幅優先探索を使う場合は、メモリの消費量を抑える工夫も必要になります。
経路の管理はキューを使うと簡単です。幅優先探索でのキューの動作を下図に示します。
(1) ───── QUEUE ──────
┌── (A)
│ ───────────────
│
└─→ キューからデータを取り出す
(2) ───── QUEUE ──────
←─┐
─────────────── │
│
(A) の経路を進め (A B) ───┤
キューに追加する (A C) ───┘
(3) ───── QUEUE ──────
┌── (A B) (A C) ←─┐
│ ─────────────── │
│ │
└─→ (A B) の経路を進めキューに追加 │
(A B C) (A B D) ────────┘
(4) ───── QUEUE ──────
┌── (A C) (A B C) (A B D) ←─┐
│ ─────────────── │
│ │
└─→ キューに経路がある間繰り返す ──┘
図 : 幅優先探索とキューの動作
最初は、(1) のように出発点をキューにセットしておきます。次に、キューから経路を取り出し、(2) のように経路 (A) を一つ進めて、経路 (A B) (A C) を作り、それをキューに追加します。(3) では、経路 (A B) を取り出して、一つ進めた経路 (A B C) と (A B D) をキューに追加します。あとはキューに経路がある間、処理を繰り返せばいいわけです。
キューは先入れ先出し (FIFO) の性質を持つデータ構造です。距離の短い経路から順番に処理されるため、幅優先探索として機能するわけです。
それではプログラムを作りましょう。次のリストを見てください。
リスト : 経路の探索 (2)
;;; 幅優先探索
(defun breadth-first-search (start goal)
(let ((q (make-queue)))
(enqueue q (list start))
(loop
(if (emptyp q) (return))
(let ((path (dequeue q)))
(if (eq (car path) goal)
(print (reverse path))
(dolist (x (cdr (assoc (car path) *adjacent*)))
(unless (member x path)
(enqueue q (cons x path)))))))))
関数 breadth-first-search は START から GOAL までの経路を幅優先探索で求めます。最初に make-queue でキュー Q を生成して、出発点 (start) だけの経路をキューに追加します。ここでは前回の「構造体 : リストによるキューの実装」で作成したプログラムを使っています。
あとは、キューにデータがある間、loop で探索処理を続行します。経路をのばす処理はバックトラックのプログラムとほぼ同じです。ひとつのばした経路はキュー Q に追加するところに注意してください。
それでは実行してみましょう。
* (breadth-first-search 'a 'g) (A C E G) (A B C E G) (A B D E G) (A C B D E G) NIL
結果を見ればおわかりのように、最初に見つかる経路が最短で、最後に見つかる経路が最長となります。当然ですが経路の総数は 4 通りになります。
幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときには使うことができないという欠点があります。逆に深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。
それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていくという方法です。
たとえば、1 手で解が見つからない場合は 2 手までを探索し、それでも見つからない場合は 3 手までを探索するというように、制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping)」といいます。
反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要がないため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大する、という欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。
それでは、経路図で A から G までの経路を反復深化で求めてみましょう。反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を 1 手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。
リスト : 経路の探索 (3)
;;; 反復深化用深さ優先探索
(defun dfs (limit goal path)
(if (= (length path) limit)
(when (eq (car path) goal)
(format t "~a~%" (reverse path)))
(dolist (x (cdr (assoc (car path) *adjacent*)))
(unless (member x path)
(dfs limit goal (cons x path))))))
;;; 反復深化
(defun id-search (start goal)
(do ((i 2 (1+ i)))
((> i 7))
(format t "----- ~d -----~%" i)
(dfs i goal (list start))))
実際の処理は関数 dfs で行います。引数 LIMIT が上限値を表します。dfs は LIMIT まで深さ優先探索を行います。経路の長さを length で求めて、これが上限値 LIMIT に達したら探索を打ち切ります。このとき GOAL に到達したかチェックします。あとは、LIMIT の値を増やしながら dfs を呼び出せばいいわけです。
それでは実行結果を示しましょう。
* (id-search 'a 'g) ----- 2 ----- ----- 3 ----- ----- 4 ----- (A C E G) ----- 5 ----- (A B C E G) (A B D E G) ----- 6 ----- (A C B D E G) ----- 7 ----- NIL
結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムではすべての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。
それでは簡単な例題として、パズル「水差し問題」を解いてみましょう。このパズルはいろいろな呼び方があって、参考文献 1 『Ｃ言語による最新アルゴリズム事典』では「水をはかる問題」ですが、参考文献 2 『Prolog の技芸』は「水差し問題」と呼んでいます。このほかに、「水を測り出す問題」と呼ぶ場合があります。それでは問題です。
大きな容器に水が入っています。目盛の付いていない 8 リットルと 5 リットルの容器を使って、大きな容器から 4 リットルの水を汲み出してください。4 リットルの水は、どちらの容器に入れてもかまいません。水をはかる最短手順を求めてください。なお、水の総量に制限はありません。
水差し問題の場合、次に示す 3 通りの操作があります。
3 の操作は、容器が空になるまで水を移す場合と、もう一方の容器が満杯になるまで水を移す場合があります。容器は 2 つあるので、全部で 6 通りの操作があります。これらの操作を次に示す関数で行うことにします。
リスト : 容器の操作関数
;;; 容器の容量 (定数)
(defconstant max-a 8)
(defconstant max-b 5)
;;; 容器の操作関数
(defun full-a (state)
(list max-a (second state)))
(defun clear-a (state)
(list 0 (second state)))
(defun a-to-b (state)
(let ((a (first state))
(d (- max-b (second state))))
(if (<= a d)
(list 0 (+ (second state) a))
(list (- a d) max-b))))
(defun full-b (state)
(list (first state) max-b))
(defun clear-b (state)
(list (first state) 0))
(defun b-to-a (state)
(let ((b (second state))
(d (- max-a (first state))))
(if (<= b d)
(list (+ (first state) b) 0)
(list max-a (- b d)))))
;;; 操作関数リスト
(defconstant op-list
(list #'full-a #'clear-a #'a-to-b #'full-b #'clear-b #'b-to-a))
8 リットルの容器を A とし、5 リットルの容器を B とします。容量は定数 MAX-A と MAX-B に定義します。defconstant は定数を定義するマクロです。定数は setq などで値を書き換えることはできません。各関数の引数 STATE は A と B の水の量を格納したリスト (a b) です。
容器を空にする操作 (clear-X) と満杯にする操作 (Full-X) は簡単ですね。他の容器に水を移す操作は、容器の空き容量を調べて水が全部入るかチェックしています。これらの関数は定数 OP-LIST にセットしておきます。
最初は単純な深さ優先探索で水差し問題を解いてみましょう。次のリストを見てください。
リスト : 深さ優先探索
(defun water-jug-dfs (goal &optional (states '((0 0))))
(if (or (= (first (car states)) goal)
(= (second (car states)) goal))
(progn (format t "~a~%" (reverse states)) t)
(dolist (fn op-list)
(let ((newstate (funcall fn (car states))))
(unless (member newstate states :test #'equal)
(when (water-jug-dfs goal (cons newstate states))
(return t)))))))
操作手順は容器の状態を格納したリストで表すことにします。これを引数 STATES に格納します。引数 GOAL は汲みだす水の量です。最初の if で、A または B の容器に GOAL リットルの水があるかチェックします。そうであれば、format で手順を表示して T を返します。
そうでなければ、dolist で OP-LIST から操作関数を取り出して、新しい状態 NEWSTATE を作ります。STATES の中に NEWSTATE と同じ状態が無ければ water-jug-dfs を再帰呼び出しします。返り値が真の場合、解を一つ見つけたので探索を打ち切ります。return で dolist を脱出して T を返します。
それでは実行してみましょう。
* (water-jug-dfs 4) ((0 0) (8 0) (3 5) (8 5) (0 5) (5 0) (5 5) (8 2) (0 2) (2 0) (2 5) (7 0) (7 5) (8 4)) T
13 回の操作 (初期状態を入れた個数は 14) で 4 リットルの水を汲みだすことができました。ですが、これは最短の手数ではありません。次は幅優先探索で最短手数を求めてみましょう。
プログラムは次のようになります。
リスト : 幅優先探索
(defun water-jug (goal)
(let ((que (make-queue)))
(enqueue que '((0 0)))
(loop
(if (emptyp que) (return))
(let ((states (dequeue que)))
(when (or (= (first (car states)) goal)
(= (second (car states)) goal))
(print (reverse states))
(return))
(dolist (fn op-list)
(let ((newstate (funcall fn (car states))))
(unless (member newstate states :test #'equal)
(enqueue que (cons newstate states)))))))))
make-queue でキューを生成し、そこに初期状態 (0 0) を格納したリストを追加します。あとは loop でキューから STATES を取り出して、GOAL に到達するまで処理を繰り返すだけです。
実行結果を示します。
* (water-jug-bfs 4) ((0 0) (0 5) (5 0) (5 5) (8 2) (0 2) (2 0) (2 5) (7 0) (7 5) (8 4)) NIL
最短手数は 10 手 (状態数は 11 個) になりました。
最後に反復深化で水差し問題を解いてみましょう。プログラムは次のようになります。
リスト : 反復深化
(defun water-jug-dfs-id (limit goal states)
(if (= (length states) limit)
(when (or (= (first (car states)) goal)
(= (second (car states)) goal))
(format t "~a~%" (reverse states))
t)
(dolist (fn op-list)
(let ((newstate (funcall fn (car states))))
(unless (member newstate states :test #'equal)
(when (water-jug-dfs-id limit goal (cons newstate states))
(return t)))))))
(defun water-jug-id (goal)
(do ((i 2 (1+ i)))
(nil)
(format t "----- ~d -----~%" i)
(when (water-jug-dfs-id i goal '((0 0)))
(return))))
上限値 LIMIT は状態数でチェックしているので、手数は limit - 1 になることに注意してください。あとは特に難しいところはないと思います。
実行結果を示します。
* (water-jug-id 4) ----- 2 ----- ----- 3 ----- ----- 4 ----- ----- 5 ----- ----- 6 ----- ----- 7 ----- ----- 8 ----- ----- 9 ----- ----- 10 ----- ----- 11 ----- ((0 0) (0 5) (5 0) (5 5) (8 2) (0 2) (2 0) (2 5) (7 0) (7 5) (8 4)) NIL
結果は幅優先探索と同じです。
リスト : 経路の探索
;;; キューの定義
(defstruct queue (front nil) (rear nil))
;;; キューは空か？
(defun emptyp (q)
(null (queue-front q)))
;;; データの挿入
(defun enqueue (q item)
(let ((new-cell (list item)))
(if (emptyp q)
;; キューは空の状態
(setf (queue-front q) new-cell)
;; 最終セルを書き換える
(setf (cdr (queue-rear q)) new-cell))
(setf (queue-rear q) new-cell)))
;;; データを取得
(defun dequeue (q)
(unless (emptyp q)
(prog1
(pop (queue-front q))
(when (emptyp q)
;; キューは空になった
(setf (queue-rear q) nil)))))
;;; 隣接リスト
(defvar *adjacent*
'((A B C)
(B A C D)
(C A B E)
(D B E F)
(E C D G)
(F D)
(G E)))
;;; 深さ優先探索
(defun depth-first-search (goal path)
(if (eq (car path) goal)
(print (reverse path))
(dolist (x (cdr (assoc (car path) *adjacent*)))
(unless (member x path)
(depth-first-search goal (cons x path))))))
;;; 幅優先探索
(defun breadth-first-search (start goal)
(let ((q (make-queue)))
(enqueue q (list start))
(loop
(if (emptyp q) (return))
(let ((path (dequeue q)))
(if (eq (car path) goal)
(print (reverse path))
(dolist (x (cdr (assoc (car path) *adjacent*)))
(unless (member x path)
(enqueue q (cons x path)))))))))
;;; 反復深化用深さ優先探索
(defun dfs (limit goal path)
(if (= (length path) limit)
(when (eq (car path) goal)
(format t "~a~%" (reverse path)))
(dolist (x (cdr (assoc (car path) *adjacent*)))
(unless (member x path)
(dfs limit goal (cons x path))))))
;;; 反復深化
(defun id-search (start goal)
(do ((i 2 (1+ i)))
((> i 7))
(format t "----- ~d -----~%" i)
(dfs i goal (list start))))
;;;
;;; 水差し問題
;;;
;;; 容器の容量 (定数)
(defconstant max-a 8)
(defconstant max-b 5)
;;; 容器の操作関数
(defun full-a (state)
(list max-a (second state)))
(defun clear-a (state)
(list 0 (second state)))
(defun a-to-b (state)
(let ((a (first state))
(d (- max-b (second state))))
(if (<= a d)
(list 0 (+ (second state) a))
(list (- a d) max-b))))
(defun full-b (state)
(list (first state) max-b))
(defun clear-b (state)
(list (first state) 0))
(defun b-to-a (state)
(let ((b (second state))
(d (- max-a (first state))))
(if (<= b d)
(list (+ (first state) b) 0)
(list max-a (- b d)))))
;;; 操作関数リスト
(defconstant op-list
(list #'full-a #'clear-a #'a-to-b #'full-b #'clear-b #'b-to-a))
;;; 深さ優先探索
(defun water-jug-dfs (goal &optional (states '((0 0))))
(if (or (= (first (car states)) goal)
(= (second (car states)) goal))
(progn (format t "~a~%" (reverse states)) t)
(dolist (fn op-list)
(let ((newstate (funcall fn (car states))))
(unless (member newstate states :test #'equal)
(when (water-jug-dfs goal (cons newstate states))
(return t)))))))
;;; 幅優先探索
(defun water-jug-bfs (goal)
(let ((que (make-queue)))
(enqueue que '((0 0)))
(loop
(if (emptyp que) (return))
(let ((states (dequeue que)))
(when (or (= (first (car states)) goal)
(= (second (car states)) goal))
(print (reverse states))
(return))
(dolist (fn op-list)
(let ((newstate (funcall fn (car states))))
(unless (member newstate states :test #'equal)
(enqueue que (cons newstate states)))))))))
;;; 反復深化
(defun water-jug-dfs-id (limit goal states)
(if (= (length states) limit)
(when (or (= (first (car states)) goal)
(= (second (car states)) goal))
(format t "~a~%" (reverse states))
t)
(dolist (fn op-list)
(let ((newstate (funcall fn (car states))))
(unless (member newstate states :test #'equal)
(when (water-jug-dfs-id limit goal (cons newstate states))
(return t)))))))
(defun water-jug-id (goal)
(do ((i 2 (1+ i)))
(nil)
(format t "----- ~d -----~%" i)
(when (water-jug-dfs-id i goal '((0 0)))
(return))))