お気楽 Haskell プログラミング入門

はじめに

「経路の探索」の続きです。今回は「反復深化」というアルゴリズムを説明します。

●反復深化

幅優先探索は最短手数を求めるのに適したアルゴリズムですが、生成する局面数が多くなると大量のメモリを必要とします。このため、メモリが不足するときは、幅優先探索を使うことができません。深さ優先探索の場合、メモリの消費量は少ないのですが、最初に見つかる解が最短手数とは限らないという問題点があります。

それでは、大量のメモリを使わずに最短手数を求める方法はないのでしょうか。実は、とても簡単な方法があるのです。それは、深さ優先探索の「深さ」に上限値を設定し、解が見つかるまで上限値を段階的に増やしていく、という方法です。

たとえば、1 手で解が見つからない場合は、2 手までを探索し、それでも見つからない場合は 3 手までを探索する、というように制限値を 1 手ずつ増やしていくわけです。このアルゴリズムを「反復深化 (iterative deeping)」といいます。

反復深化は最短手数を求めることができるアルゴリズムですが、幅優先探索と違って局面を保存する必要が無いため、必要となるメモリは深さ優先探索と同程度で済みます。また、プログラムも深さ優先探索と同じくらい簡単に作成することができます。ただし、同じ探索を何度も繰り返すため実行時間が増大するという欠点があります。ようするに、使用するメモリは少ないが実行時間が長くなるアルゴリズムなのです。

●反復深化のプログラム

それでは、同じ経路図を使って反復深化を具体的に説明しましょう。

    Ｂ------Ｄ------Ｆ
  ／│      │          
Ａ  │      │          
  ＼│      │          
    Ｃ------Ｅ------Ｇ

      図 :経路図

反復深化のプログラムはとても簡単です。設定した上限値まで深さ優先探索を行う関数を作り、上限値を１手ずつ増やしてその関数を呼び出せばいいのです。プログラムは次のようになります。

リスト : 反復深化

-- 隣接リスト
adjacent :: [[Int]]
adjacent =
  [[1,2],
   [0,2,3],
   [0,1,4],
   [1,4,5],
   [2,3,6],
   [3],
   [4]]

-- 次の頂点へ進む
nextPath :: [Int] -> [[Int]]
nextPath path@(x:xs) = [y:path | y <- adjacent !! x, y `notElem` xs]

-- 反復深化
ids :: Int -> Int -> IO ()
ids start goal = iter 1 where
  dfs n m path@(x:xs)
    | n == m    = if x == goal then print (reverse path) else return ()
    | otherwise = mapM_ (dfs (n + 1) m) $ nextPath path
  iter 7 = return ()
  iter m = do
    dfs 0 m [start]
    iter (m + 1)

-- リストに格納する
ids' :: Int -> Int -> [[Int]]
ids' start goal = iter 1 where
  dfs n m ys path@(x:xs)
    | n == m    = if x == goal then reverse path : ys else ys
    | otherwise = foldl (dfs (n + 1) m) ys $ nextPath path
  iter 7 = []
  iter m = dfs 0 m [] [start] ++ iter (m + 1)

局所関数 iter で上限値を増やしていき、局所関数 dfs で深さ優先探索を行います。引数 n が経路長、引数 m が上限値を表します。n が m に達したら探索を打ち切ります。このとき、ゴールに到達したかチェックします。あとは、m の値を増やしながら dfs を呼び出せばいいわけです。関数 ids' は見つけた解をリストに格納して返します。

それでは実行結果を示しましょう。

ghci> ids 0 6
[0,2,4,6]
[0,1,2,4,6]
[0,1,3,4,6]
[0,2,1,3,4,6]
ghci> ids 6 0
[6,4,2,0]
[6,4,2,1,0]
[6,4,3,1,0]
[6,4,3,1,2,0]
ghci> ids' 0 6
[[0,2,4,6],[0,1,3,4,6],[0,1,2,4,6],[0,2,1,3,4,6]]
ghci> ids' 6 0
[[6,4,2,0],[6,4,3,1,0],[6,4,2,1,0],[6,4,3,1,2,0]]

結果を見ればおわかりのように、最初に見つかる解が最短手数になります。このプログラムでは全ての経路を求めましたが、最短手数を求めるだけでよい場合は、解が見つかった時点で探索を終了すればいいでしょう。

●探索の一般化

ところで、深さ優先探索と幅優先探索は高階関数を使うと一般化することができます。次のリストを見てください。

リスト : 探索の一般化

-- 解をリストに格納して返す
search :: (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> [a]
search _ _ _ [] = []
search isGoal nextState combine (x:xs) =
  if isGoal x then x : search isGoal nextState combine xs
  else search isGoal nextState combine (combine (nextState x) xs)

-- 解を一つだけ求める
search' :: (a -> Bool) -> (a -> b) -> (b -> [a] -> [a]) -> [a] -> Maybe a
search' _ _ _ [] = Nothing
search' isGoal nextState combine (x:xs) =
  if isGoal x then Just x 
  else search' isGoal nextState combine (combine (nextState x) xs)

関数 search はまだ調べていない局面 (state) を格納したリスト (stateList) を受け取り、その先頭から局面を取り出して新しい局面を生成することで探索を進めます。isGoal はゴールに到達したか調べる述語、nextState は現在の局面から新しい局面を生成してリストに格納して返す関数、combine は新しく生成した局面を stateList に連結する関数、最後の引数が stateList です。

最初に、stateList が空リストであれば、空リストを返して探索を終了します。次に、先頭の局面 x を取り出して、ゴールに到達しているか isGoal でチェックします。isGoal が True であれば x を search の返り値 (リスト) に追加します。そうでなければ、search を再帰呼び出しします。このとき、x に nextState を適用して新しい局面を生成し、combine で xs に追加します。チェックした局面 x は stateList から取り除くことに注意してください。

解を一つ求めるだけでよければ、関数 search' のように isGoal の返り値が True であれば Just x を返して、ここで探索を打ち切ります。解が見つからない場合は Nothing を返します。

深さ優先探索は経路を先へ先へと進めていく探索なので、stateList の先頭に新しい局面を追加することで実現できます。combine にはリストを連結する関数を渡します。演算子 ++ をカッコで囲めばカリー化関数として渡すことができます。幅優先探索はすべての経路を並行に探索していくので、stateList の末尾に新しい局面を追加することで実現できます。combine には flip (++) を渡します。ただし、演算子 ++ を使う場合、たくさんの局面が生成されると効率は悪くなります。

それでは、実際に経路の探索を行ってみましょう。

ghci> map reverse $ search (\x -> head x == 6) nextPath (++) [[0]]
[[0,1,2,4,6],[0,1,3,4,6],[0,2,1,3,4,6],[0,2,4,6]]
ghci> map reverse $ search (\x -> head x == 6) nextPath (flip (++)) [[0]]
[[0,2,4,6],[0,1,2,4,6],[0,1,3,4,6],[0,2,1,3,4,6]]
ghci> fmap reverse $ search' (\x -> head x == 6) nextPath (++) [[0]]
Just [0,1,2,4,6]
ghci> fmap reverse $ search' (\x -> head x == 6) nextPath (flip (++)) [[0]]
Just [0,2,4,6]

経路が逆順になるので reverse で反転しています。深さ優先探索と幅優先探索どちらも正常に動作していますね。

●プログラムリスト