探索問題を Haskell で解く

#はじめに
ふだんあまり意識しませんが、プログラムのいろいろな部分に探索が隠れています。探索とは可能性を列挙して、その中から条件に該当するものを残して絞り込むことです。（いつかまとめたいと思っていますが、手続き型言語での for 文はすべて探索を内包していると筆者は考えています）

さて、 C 言語の初学者が練習する 配列の中からある値を探しそのインデックスを返す という問題がもっとも原始的な探索です。 JavaScript では同様の機能が Array に indexOf メソッドとして実装されています。（余談ですが JavaScript の Array　には filter という、条件に合致する「すべて」の要素を見つける探索関数があるので、こちらの利用をお勧めします）

この記事では、より一般的な探索問題を紹介し、 Haskell を使った実装例を示します。

#可能性の列挙
探索とは、辿りうる経路をすべて列挙し、条件に合致するものを取り出す操作だと言い換えられます。

本記事では割愛しますが、実際の応用では全列挙がメモリーや計算時間などの都合で厳しい（例えば将棋の可能性の盤面をすべて列挙することは非現実的です）ため、探索の中途で経路をいくつか刈り取ってしまう 枝刈り と呼ばれる技法があります。

可能性（経路）の列挙は表に出てこないこともあります。例えば表計算ソフトは二次元の数字配列を扱います。その中からある値を超えるセルを見つける、これも原始的な探索です。しかしこの場合、列挙せずともセルの全ての値は二次元配列としてあらかじめプログラマーの手元にあります。（探索経路を、列と行、いずれを優先するかという選択はあります）

「地図上で現在地から目的地への経路を調べる」、「乗り継ぎを含め終電に間に合うギリギリの出発時刻を見つける」、「ある盤面からより有利な盤面にたどりつくための指し手を考える」、……これら一般の探索問題は「グラフ」と呼ばれる木構造になります。

A --> B --> D --> F
 ¥           ¥
  ¥           ¥----¥
   ¥                ¥
    ¥--> C --> E --> G
          ¥         /
           ¥-------/

例えば上図で A から G にたどり着くための経路は [A, B, D, G], [A, C, E, G], [A, C, G] の 3 通りあります。

この経路をすべて列挙する方法に、幅優先探索と深さ優先探索と呼ばれるふたつがあります。

##幅優先探索

A から見て、一歩で辿りつけるのは B, C です。

• A - B
• A - C

B からは一歩で D に、 C からは E, G に行けます。

• A - B - D
• A - C - E
• A - C - G

D からは一歩で F と G に行け、 E から一歩先は G です。 G から先はありません。

• A - B - D - F
• A - B - D - G
• A - C - E - G
• A - C - G (Goal)

F と G はそれぞれ行き止まりのため、この四経路がすべてです。
各手順で現在の経路の一歩先を見ることから、手順を繰り返すごとに長さが同じ経路がいくつか増えていきます。
探索の経路、木が年を経るごとに枝を横に広げていく様子に見立て、これを幅優先探索といいます。

また見てわかるとおり、この手順はゴールに辿りつく経路が見つかったとき、それが最短経路であることを保証します。（最短経路が同時に複数見つかることもあります）

##深さ優先探索

これに対し、深さ優先探索は枝を辿れるだけ進み、行き止まりにぶつかったら一歩もどり、別経路を探すバックトラックを使って経路を探します。

先の図では A - B - D - F と辿って、行き止まりにぶつかる。
一歩もどり（バックトラック） D からは G に行けるので A - B - D - G を経路に加える。これも行き止まり。
D からは F と G にしか行けないためさらに戻り B、ここからも別経路はないので A まで戻り C を見つけ……

という具合です。
深さ優先探索は経路の発見に使う、つまり A - B - D - G の経路を見つけた時点で探索を打ち切ることが一般的のようにおもいます。

幅優先と比較して、途中経路を覚えておくメモリーが少なくて済む反面、バックトラックの実装や管理が（手続き型言語では）難しくなる傾向があります。

Haskell で実装してみよう

前置きで随分紙幅を費やしてしまいました。急いで実装をご紹介します。

まずノードを示す Node 型とノード間の接続関係を示す Edge 型、ノード列を経路として示す Path 型、そしてエッジを列挙した値 edges を定義します。

type Node = Char
type Edge = (Node, Node)
type Path = [Node]

edges :: [Edge]
edges = [('A', 'B'), ('A', 'C'), ('B', 'D'), ('C', 'E'), ('C', 'G'), ('D', 'F'), ('D', 'G'), ('E', 'G')]

あるノードから隣接ノードを探す関数 next は次のように定義できます。

next :: Node -> [Edge] -> [Node]
next n = (map snd).(filter ((n ==).fst))

幅優先探索補助関数

さて、幅優先でパスを検索する補助関数の定義です。

-- build paths by breadth first
_byB :: MonadPlus m => Node -> [Edge] -> [Path] -> m Path
_byB _ _ [] = mzero
_byB n es (p:ps)
  | (p!!0) == n = (return p) `mplus` (_byB n es ps)
  | otherwise   = _byB n es $ ps ++ (map (:p) $ next (p!!0) es)

第一引数 n は目指すゴールのノード、第二引数は探索するグラフを構成するエッジのリスト、そして第三引数が列挙中のパスすべてです。
もどす型を MonadPlus でつつんでいます。この MonadPlus は List あるいは Maybe のインスタンスを当てることで、最終的に、全経路を返すか、あるいは最初に見つかった経路を返すか、という選択の幅に変わります。

• 列挙パスのキューが空になったら、そこに連なるパスの列挙は失敗（3 行目）、
• キュー先頭のパスの頭がゴールノードならば、これは候補として返しつつ残りのキュー内のパスの確認を継続（5 行目）
• そうでなければ、残りのキューの確認を優先しつつ、今見ていたパスの先頭ノードから辿れるパスのすべてを接続してキューの末尾に追加（6 行目）

キューの末尾に追加という操作が幅優先探索を決定づけます。

##深さ優先探索
では深さ優先探索の定義を見てみましょう。

-- build paths by depth first
_byD :: MonadPlus m => Node -> [Edge] -> [Path] -> m Path
_byD _ _ [] = mzero
_byD n es (p:ps)
  | (p!!0) == n = (return p) `mplus` (_byD n es ps)
  | otherwise   = _byD n es $ (map (:p) $ next (p!!0) es) ++ ps

お気づきでしょうか？
変わったのは 6 行目の定義だけです。
幅優先探索ではキューの末尾に、移動できるノードを足したパス群を追加しましたが、深さを優先する場合はキューの先頭に積むのです。

これにより、列挙はノードの先へ、先へと進むことになるのです。

##全経路の列挙
そして以下の関数で、幅優先、深さ優先の補助関数をつないで全経路列挙関数の定義とします。

-- list all paths by List
allPaths :: (Node -> [Edge] -> [Path] -> [Path])
              -> Node -> Node -> [Edge] -> [Path]
allPaths f p0 p1 es = fmap reverse $ f p1 es [[p0]]

第一引数に先の補助関数 _byB（幅優先）もしくは _byD（深さ優先）を指定します。そして順に、始点ノード、終点ノード、グラフ定義（エッジのリスト）、を与えます。
先の MonadPlus はリストになったため、第一引数の関数の型情報が変化していることに注意。
また補助関数内では逆順に経路を管理していたので、関数本体で値を戻す前に fmap reverse を適用して正順に並べ替えています。

$ ghci search-exmaple.hs
GHCi, version 8.2.1: http://www.haskell.org/ghc/  :? for help
[1 of 1] Compiling Main             ( search-example.hs, interpreted )
Ok, 1 module loaded.
*Main> allPaths _byB 'A' 'G' edges
["ACG","ABDG","ACEG"]
*Main> allPaths _byD 'A' 'G' edges
["ABDG","ACEG","ACG"]
*Main> 

そのように実装したからですが、ちゃんと動いていますね。 ;-)

##最初にマッチした経路のみ列挙

以下定義により、幅優先、あるいは深さ優先で最初に見つかったパスを返して即、終了させることも可能です。

-- list first path by Maybe
firstPath :: (Node -> [Edge] -> [Path] -> Maybe Path)
               -> Node -> Node -> [Edge] -> Maybe Path
firstPath f p0 p1 es = fmap reverse $ f p1 es [[p0]]

実は関数本体は allPaths と全く同じ。違うのは型定義だけです。
よって GHCi で以下のように、お手軽に試すこともできます。

*Main> (fmap reverse $ _byD 'G' edges ["A"]) :: [Path]
["ABDG","ACEG","ACG"]
*Main> (fmap reverse $ _byD 'G' edges ["A"]) :: Maybe Path
Just "ABDG"

##ソースコード
先のソースコードをひとまとめにして掲載します。

import Control.Monad

type Node = Char
type Edge = (Node, Node)
type Path = [Node]

edges :: [Edge]
edges = [('A', 'B'), ('A', 'C'), ('B', 'D'), ('C', 'E'), ('C', 'G'), ('D', 'F')\
, ('D', 'G'), ('E', 'G')]

next :: Node -> [Edge] -> [Node]
next n = (map snd).(filter ((n ==).fst))

-- build paths by breadth first
_byB :: MonadPlus m => Node -> [Edge] -> [Path] -> m Path
_byB _ _ [] = mzero
_byB n es (p:ps)
  | (p!!0) == n = (return p) `mplus` (_byB n es ps)
  | otherwise   = _byB n es $ ps ++ (map (:p) $ next (p!!0) es)

-- build paths by depth first
_byD :: MonadPlus m => Node -> [Edge] -> [Path] -> m Path
_byD _ _ [] = mzero
_byD n es (p:ps)
  | (p!!0) == n = (return p) `mplus` (_byD n es ps)
  | otherwise   = _byD n es $ (map (:p) $ next (p!!0) es) ++ ps


-- list all paths by List
allPaths :: (Node -> [Edge] -> [Path] -> [Path])
              -> Node -> Node -> [Edge] -> [Path]
allPaths f p0 p1 es = fmap reverse $ f p1 es [[p0]]


-- list first path by Maybe
firstPath :: (Node -> [Edge] -> [Path] -> Maybe Path)
               -> Node -> Node -> [Edge] -> Maybe Path
firstPath f p0 p1 es = fmap reverse $ f p1 es [[p0]]

#まとめ
幅優先と深さ優先による探索を紹介し、モナドを使って全列挙、あるいは最初に見つかったものだけを抽出する方法をお見せしました。

注意点がひとつ。
この記事の探索コードは、ループを持つグラフに対するケアをしていません。

ループを持つグラフに allPaths を適用するとなにが起きるのか、どのような対策ができるのか、考えてみてください。

#参考情報

• Haskell のお勉強 | 9. 探索
• 書籍「すごいHaskellたのしく学ぼう！」（「すごいH本」）