今回は、地図上の A 地点から B 地点までの道順を求める、といった「経路の探索」と呼ばれる問題を取り上げます。「探索」にはいろいろな種類があります。「8 クイーン」 のようなパズルの解法も、あらゆる可能性の中から正解に行き着く手順を探すことですから、探索の一つと考えることができます。そして、探索でよく用いられる最も基本的な方法が「バックトラック」なのです。もちろん、経路の探索もバックトラックで解くことができます。
このほかに、もう一つ基本的な方法として「幅優先探索」があります。バックトラックの場合、失敗したら後戻りして別の道を選び直しますが、幅優先探索の場合は、全ての経路について並行に探索を進めていきます。今回は、この 2 つの方法で問題を解いてみましょう。
簡単な例題として、次に示す経路を考えてみます。
Ｂ------Ｄ------Ｆ
／│ │
Ａ │ │
＼│ │
Ｃ------Ｅ------Ｇ
図 :経路図
点とそれを接続する線からなる図形を「グラフ (graph)」といいます。点のことを「頂点 (vertex)」とか「節 (node)」と呼び、線のことを「辺 (edge)」とか「弧 (arc)」と呼びます。グラフには 2 種類あって、辺に向きがないものを「無向グラフ」といい、向きがあるものを「有向グラフ」といいます。有向グラフは一方通行の道と考えるとわかりやすいでしょう。上図ではアルファベットで頂点を表しています。今回は経路をグラフで表していますが、このほかにもいろいろな問題をグラフで表現することができます。
グラフをプログラムする場合、よく使われる方法が「隣接行列」と「隣接リスト」です。隣接行列は 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 がセットされます。
隣接行列の欠点は、辺の数が少ない場合でも N 行 N 列の行列が必要になることです。つまり、ほとんどの要素が 0 になってしまい、メモリを浪費してしまうのです。この欠点を補う方法に隣接リストがあります。これは、つながっている頂点を格納する方法です。次の図を見てください。
A => [B, C] B => [A, C, D] C => [A, B, E] D => [B, E, F] E => [C, D, G] F => [D] G => [E] 図 : 隣接リスト
上図は、頂点とそこに接続されている頂点を => と [ ] で表しています。これを Haskell で表すと、次のようになります。
リスト : 隣接リスト adjacent :: [[Int]] adjacent = [[1, 2], -- A [0, 2, 3], -- B [0, 1, 4], -- C [1, 4, 5], -- D [2, 3, 6], -- E [3], -- F [4]] -- G
頂点 A から G を数値 0 から 6 に対応させるところがポイントです。すると、隣接リスト adjacent のデータ型は [[Int]] で表すことができます。
ところで、隣接リストにも欠点があります。たとえば、E と G が接続しているか調べるには、データを順番に調べていくしか方法がありません。このため、接続の判定に時間がかかることがあるのです。まあ、頂点に接続されている辺の数が少なければ、処理速度が極端に遅くなることはないでしょう。
それでは、隣接リストを使って A から G までの経路をバックトラックで求めてみましょう。バックトラックの実装にはスタックを使うと簡単です。また、明示的にスタックを使わなくても再帰呼び出しで簡単に実装することもできます。
(1) ───── STACK ─────┐
┌── [A] │
│ ──────────────┘
│
└─→ スタックからデータを取り出す
(2) ───── STACK ─────┐
┌──→ │
│ ──────────────┘
│
├─── [A,B] [A] の経路を進め
└─── [A,C] スタックに追加する
(3) ───── STACK ─────┐
┌── [A,C] [A,B] │
│ ──────────────┘
│
└─→ [A,C] の経路を進めスタックに追加
┌── [A,C,B] [A,C,E]
│
│ ───── STACK ─────┐
└─→ [A,B] │
──────────────┘
(4) ───── STACK ─────┐
┌── [A,C,E] [A,C,B] [A,B] │
│ ──────────────┘
│
└─→ スタックに経路がある間繰り返す
┌── [A,C,E,D] [A,C,E,G]
│
│ ───── STACK ─────┐
└─→ [A,C,B] [A,B] │
──────────────┘
図 : 深さ優先探索とスタックの動作
経路は頂点を並べたリストで表すことにします。バックトラックによる経路の探索は上図のような動作になります。最初、スタックに出発点を格納した経路 [A] を入れます。次に、スタックから経路を一つ取り出します (1)。そして、経路 [A] を一つ進めた経路 [A,B], [A,C] を作成し、それをスタックに追加します (2)。
ここでスタックには経路 [A,B], [A,C] が格納されます。同様にスタックからデータを取り出して経路を一つ進めます、取り出した経路が [A,C] とすると、一つ進めた経路は [A,C,B], [A,C,E] で、これをスタックに追加します (3)。あとは同様に、スタックからデータを取り出して経路を一つ進めます (4)。これをゴールに到達するか、スタックが空になるまで繰り返します。
ここで、スタックから取り出した経路を順番に並べてみましょう。
[A] => [A, C] => [A, C, E] => ...
ひとつの経路を延ばして探索をすすめていることがわかります。このように、スタックを使って探索を行うと、経路を先へ先へ進めるので、「縦形探索」とか「深さ優先探索」と呼ばれています。
バックトラックも簡単です。次の図を見てください。
───── STACK ─────┐
┌── [A,C,E,D] [A,C,B] [A,B] │
│ ──────────────┘
│
└─→ [A,C,E,G] 行き止まり
│
│ 次のデータを取り出す
└─→ [A,C,E,D]
[A] => [A,C] => [A,C,E] => [A,C,E,G] 行き止まり
=> [A,C,E,D] バックトラック
図 : バックトラックの動作
行き止まりになったら、その経路を捨ててスタックから新しい経路を取り出します。たとえば、[A,C,E,G] は行き止まりなので、スタックから [A,C,E,D] を取り出します。この動作は [A,C,E,G] から [A,C,E] に戻って [A,C,E,D] に進む動作に対応します。スタックは後入れ先出し (LIFO) のデータ構造です。スタックの中には通ってきた経路が格納されているので、スタックから経路を取り出せばバックトラック (後戻り) することができるわけです。
それではプログラムを作ります。最初に経路を表すデータ構造を決めておきましょう。次の図を見てください。
A - B - D ─→ [0, 1. 3] ==> [3, 1, 0]
A - B - C - E ─→ [0, 1, 2, 4] ==> [4, 2, 1, 0]
逆順で管理する
図 : 経路の表し方
経路はリストに頂点を格納して表すことにします。リストの最後尾にデータを追加するのは面倒なので、経路は上図のように逆順で管理することにします。
求めた経路を画面に出力する場合、プログラムは次のようになります。
リスト : 深さ優先探索 (1)
import Stack
-- 次の頂点へ進む
nextPath :: [Int] -> [[Int]]
nextPath path@(x:xs) = [y:path | y <- adjacent !! x, y `notElem` xs]
-- 深さ優先探索
dfs :: Int -> Int -> IO ()
dfs start goal = iter (singleton [start]) where
iter s
| isEmptyStack s = return ()
| otherwise =
let (path, s1) = pop s
in if head path == goal then do
print (reverse path)
iter s1
else iter $ foldl push s1 $ nextPath path
モジュール Stack は拙作のページ「モジュール」で作成した Stack.hs です。関数 nextPath は隣接リスト adjacent から x の隣にある頂点 y を選んで新しい経路を生成します。このとき、経路に含まれている頂点を選んではいけません。そうしないと、同じ道をぐるぐると回る巡回経路が発生し、ゴールまでたどり着くことができなくなります。これをリスト内包表記の条件式 y `notElem` xs でチェックしています。
関数 dfs は深さ優先探索で start から goal までの経路を求めます。実際の処理は局所関数 iter で行います。iter には経路を格納したスタックを渡します。最初は出発点だけを格納した経路 [start] をスタックに積みます。そして、スタックにデータがある間、スタックから経路を取り出して探索を行います。
スタックにデータがある場合、pop でデータを取り出して、path と s1 に経路とスタックをセットします。path の先頭要素が goal と等しい場合、経路をひとつ見つけたので print で表示します。経路は逆順になっているので reverse で反転します。ここで探索を終了することもできますが、iter s1 を呼び出してバックトラックすることで全ての経路を見つけることができます。パズルの解法で解の総数を求める場合、全ての解をもれなく探索する必要があります。バックトラックを使えば、このような要求も満たすことができます。
goal に到達していない場合は新しい経路を nextPath で生成して、それをスタックに積んで iter を再帰呼び出しします。新しい経路をスタックに積む操作は畳み込み foldl を使えば簡単です。最後に、スタックが空になったら return で IO () を生成して返します。
それでは実行してみましょう。
ghci> dfs 0 6 [0,2,4,6] [0,2,1,3,4,6] [0,1,3,4,6] [0,1,2,4,6] ghci> dfs 6 0 [6,4,3,1,2,0] [6,4,3,1,0] [6,4,2,1,0] [6,4,2,0]
4 通りの経路を見つけることができました。結果を見てもわかるように、最初に見つかる経路が最短経路とは限りません。最短経路を求めるのに適したアルゴリズムが「幅優先探索」です。
ところで、見つけた経路をリストに格納して返すことも簡単です。プログラムは次のようになります。
リスト : 深さ優先探索 (2)
-- リストに格納する
dfs' :: Int -> Int -> [[Int]]
dfs' start goal = iter (singleton [start]) where
iter s
| isEmptyStack s = []
| otherwise =
let (path, s1) = pop s
in if head path == goal then reverse path : iter s1
else iter $ foldl push s1 $ nextPath path
スタックが空になったら空リスト [ ] を返します。そして、経路を一つ見つけたら、reverse で反転してから、iter の返り値のリストに追加します。
それでは実行してみましょう。
ghci> dfs' 0 6 [[0,2,4,6],[0,2,1,3,4,6],[0,1,3,4,6],[0,1,2,4,6]] ghci> dfs' 6 0 [[6,4,3,1,2,0],[6,4,3,1,0],[6,4,2,1,0],[6,4,2,0]]
なお、スタックを使わなくても演算子 ++ で深さ優先探索を実装することもできます。プログラムは次のようになります。
リスト : 深さ優先探索 (3)
dfs'' :: Int -> Int -> [[Int]]
dfs'' start goal = iter [[start]] where
iter [] = []
iter (path:xs)
| head path == goal = reverse path : iter xs
| otherwise = iter (nextPath path ++ xs)
局所関数 iter の引数がスタックのかわりになるリストです。引数が空リストの場合は空リストを返します。そうでなければ、先頭から経路 path を取り出して、ゴールに到達したかチェックします。ゴールに到達していない場合は、nextPath で新しい経路を生成し、それを演算子 ++ で xs の前に追加します。これで深さ優先探索として動作します。
次はスタックを使わずに再帰呼び出しでバックトラックを実装してみましょう。バックトラックを再帰呼び出しで実装する場合、経路を「進む」ことを再帰呼び出しに対応させるのがポイントです。たとえば、経路を探索する関数を search としましょう。search は引数として現在地点の頂点を受け取ることにします。最初は search(A) と呼び出します。そして、A から B へ進むには search(B) と呼び出します。これで B へ進むことができます。
それでは、A に戻るにはどうしたらいいのでしょう。search(B) は search(A) から呼び出されたので、search(B) の実行を終了すれば、呼び出し元である search(A) に戻ることができます。つまり、関数の実行を終了すれば、一つ手前の地点にバックトラックできるのです。このように再帰呼び出しを使うと、進むことと戻ることを関数呼び出しで簡単に実現することができます。
たとえば、経路の探索を行う関数 search を次のように定義します。
search :: Int -> [Int] -> IO ()
search の第 1 引数がゴール、第 2 引数が経路を表すリストです。リストの先頭要素が現在地点の頂点になります。search は現在地点に隣接している頂点を一つ選び、経路を進めていきます。A から Gまでの経路を求めるには、次のように呼び出します。
-- A から G までの経路を求める search 6 [0]
search は出発点 A をリストにセットし、A に接続されている頂点を選びます。隣接リストから順番に選ぶことにすると、次の頂点は B となります。B へ進むためには、次のように search を再帰呼び出しします。
-- B へ進む時の再帰呼び出し search 6 [1, 0]
この関数の実行を終了すると、呼び出し元の関数である頂点 A の処理に戻ります。これをプログラムすると次のようになります。
リスト : 深さ優先探索 (4)
dfs1 :: Int -> Int -> IO ()
dfs1 start goal = search [start] where
search path@(x:xs)
| x == goal = print (reverse path)
| otherwise = mapM_ search $ nextPath path
局所関数 search を見てください。最初に、現在地点 x がゴール goal かチェックします。これが再帰呼び出しの停止条件になります。ゴールしたら print で経路を表示します。
ゴールしていない場合は、nexPath で次の頂点を選択して新しい経路を生成します。あとは、それを search に渡して再帰呼び出しします。search は I/O アクションの関数になるので、search を実行するため関数 mapM_ を使っています。たとえば、nextPath が生成したリストが [path1, path2] とすると、最初に path1 に対して探索が行われ、バックトラックする (再帰呼び出しから戻ってくる) と次の経路 path2 に対して探索が行われます。
求めた経路をリストに格納するプログラムは次のようになります。
リスト : 深さ優先探索 (5)
-- 結果をリストに格納する
dfs1' :: Int -> Int -> [[Int]]
dfs1' start goal = search [] [start] where
search ys path@(x:xs)
| x == goal = reverse path : ys
| otherwise = foldl search ys $ nextPath path
局所関数 search の第 1 引数を累積変数として使います。経路をひとつ見つけたら累積変数 ys に追加して返します。そうでなければ、nextPath で新しい経路を作って、それを search に渡して再帰呼び出しします。累積変数 ys には新しい経路が追加されることがあるので、更新された累積変数を search が受け取れるように畳み込み foldl を使っています。
「リストモナド」を使うと上記プログラムはもっとわかりやすくなります。リストモナドについては、拙作のページ「モナド (1)」をお読みくださいませ。ご参考までにプログラムを示します。
リスト : 深さ優先探索 (6)
import Control.Monad
-- リストモナド
dfs1'' :: Int -> Int -> [[Int]]
dfs1'' start goal = search [start] where
search path@(x:xs)
| x == goal = return (reverse path)
| otherwise = do
y <- (adjacent !! x)
guard(y `notElem` xs)
search (y:path)
バックトラックによる探索は「深さ優先探索」や「縦形探索」とも呼ばれるように、一つの経路を先へ先へと進めていきます。このため最初に見つかる経路が最短経路であるとは限りません。幅優先探索は全ての経路について平行に探索を進めていくため、最初に見つかる経路が最短経路となります。
それでは、同じ経路図を使って幅優先探索を具体的に説明しましょう。幅優先探索の様子を下図に示します。
[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) の性質を持つデータ構造です。距離の短い経路から順番に処理されるため、幅優先探索として機能するわけです。
プログラムは次のようになります。
リスト : 幅優先探索
import qualified Queue as Q
bfs start goal = iter (Q.singleton [start]) where
iter q
| Q.isEmptyQueue q = return ()
| otherwise =
let (path, q1) = Q.dequeue q
in if head path == goal then do
print (reverse path)
iter q1
else iter $ foldl Q.enqueue q1 $ nextPath path
-- リストに格納する
bfs' :: Int -> Int -> [[Int]]
bfs' start goal = iter (Q.singleton [start]) where
iter q
| Q.isEmptyQueue q = []
| otherwise =
let (path, q1) = Q.dequeue q
in if head path == goal then reverse path : iter q1
else iter $ foldl Q.enqueue q1 $ nextPath path
モジュール Queue は拙作のページ「モジュール」で作成した Queue.hs です。プログラムは深さ優先探索を行う関数 dfs のスタックをキューに変更しただけで、あとの処理はほとんど同じです。これで幅優先で経路の探索が行われます。見つけた経路をリストに格納して返す関数 bfs' も同様です。
それでは実行してみましょう。
ghci> bfs 0 6 [0,2,4,6] [0,1,2,4,6] [0,1,3,4,6] [0,2,1,3,4,6] ghci> bfs 6 0 [6,4,2,0] [6,4,2,1,0] [6,4,3,1,0] [6,4,3,1,2,0] ghci> bfs' 0 6 [[0,2,4,6],[0,1,2,4,6],[0,1,3,4,6],[0,2,1,3,4,6]] ghci> bfs' 6 0 [[6,4,2,0],[6,4,2,1,0],[6,4,3,1,0],[6,4,3,1,2,0]]
結果を見ればおわかりのように、最初に見つかる経路が最短で、最後に見つかる経路が最長となります。当然ですが、経路の総数は 4 通りとなります。
この程度の問題であれば、わざわざキューを使わなくても演算子 ++ で幅優先探索を実装することができます。プログラムは次のようになります。
リスト : 幅優先探索 (2)
bfs'' :: Int -> Int -> [[Int]]
bfs'' start goal = iter [[start]] where
iter [] = []
iter (path:q)
| head path == goal = reverse path : iter q
| otherwise = iter (q ++ nextPath path)
局所関数 iter の引数がキューのかわりになるリストです。引数が空リストの場合は空リストを返します。そうでなければ、先頭から経路 path を取り出して、ゴールに到達したかチェックします。ゴールに到達していない場合は、nextPath で新しい経路を生成し、それを演算子 ++ で q の後ろに連結します。これで幅優先探索として動作します。
--
-- keiro.hs : 経路の探索
--
-- Copyright (C) 2013-2021 Makoto Hiroi
--
import Control.Monad
import Stack
import qualified Queue as Q
-- 隣接リスト
adjacent :: [[Int]]
adjacent =
[[1, 2], -- A
[0, 2, 3], -- B
[0, 1, 4], -- C
[1, 4, 5], -- D
[2, 3, 6], -- E
[3], -- F
[4]] -- G
-- 次の頂点へ進む
nextPath :: [Int] -> [[Int]]
nextPath path@(x:xs) = [y:path | y <- adjacent !! x, y `notElem` xs]
-- 深さ優先探索
dfs :: Int -> Int -> IO ()
dfs start goal = iter (singleton [start]) where
iter s
| isEmptyStack s = return ()
| otherwise =
let (path, s1) = pop s
in if head path == goal then do
print (reverse path)
iter s1
else iter $ foldl push s1 $ nextPath path
-- リストに格納する
dfs' :: Int -> Int -> [[Int]]
dfs' start goal = iter (singleton [start]) where
iter s
| isEmptyStack s = []
| otherwise =
let (path, s1) = pop s
in if head path == goal then reverse path : iter s1
else iter $ foldl push s1 $ nextPath path
dfs'' :: Int -> Int -> [[Int]]
dfs'' start goal = iter [[start]] where
iter [] = []
iter (path:xs)
| head path == goal = reverse path : iter xs
| otherwise = iter (nextPath path ++ xs)
dfs1 :: Int -> Int -> IO ()
dfs1 start goal = search [start] where
search path@(x:xs)
| x == goal = print (reverse path)
| otherwise = mapM_ search $ nextPath path
-- 結果をリストに格納する
dfs1' :: Int -> Int -> [[Int]]
dfs1' start goal = search [] [start] where
search ys path@(x:xs)
| x == goal = reverse path : ys
| otherwise = foldl search ys $ nextPath path
-- リストモナド
dfs1'' :: Int -> Int -> [[Int]]
dfs1'' start goal = search [start] where
search path@(x:xs)
| x == goal = return (reverse path)
| otherwise = do
y <- (adjacent !! x)
guard(y `notElem` xs)
search (y:path)
--
-- 幅優先探索
--
bfs start goal = iter (Q.singleton [start]) where
iter q
| Q.isEmptyQueue q = return ()
| otherwise =
let (path, q1) = Q.dequeue q
in if head path == goal then do
print (reverse path)
iter q1
else iter $ foldl Q.enqueue q1 $ nextPath path
-- リストに格納する
bfs' :: Int -> Int -> [[Int]]
bfs' start goal = iter (Q.singleton [start]) where
iter q
| Q.isEmptyQueue q = []
| otherwise =
let (path, q1) = Q.dequeue q
in if head path == goal then reverse path : iter q1
else iter $ foldl Q.enqueue q1 $ nextPath path
bfs'' :: Int -> Int -> [[Int]]
bfs'' start goal = iter [[start]] where
iter [] = []
iter (path:q)
| head path == goal = reverse path : iter q
| otherwise = iter (q ++ nextPath path)