HOME Haskell のお勉強 download 書き込む

9. 探索


この文章では、探索問題を通じて、なぜ List に Monad があるのかを説明します。

1. 探索のおさらい

ここで、探索 (search) とは 有向グラフのある点(始点)からある点(終点)までの経路を(もしあれば)求めること を指します。

探索のアルゴリズムには大きく分けて、深さ優先探索 (depth first search) と 幅優先探索 (breadth first search) の2つがあります。

深さ優先探索とは、終点にたどり着くか、行き止まりになるまで1つの経路を探索してから、 次の経路を探索する方法です。プログラムが簡単なのと、メモリー量、計算時間が比較的短くて済むという 特徴があります。ただし、最初に見つかった経路が最短経路だという保障はありません。 行き止まりになったら元の地点に戻って他の可能性を探すことをバックトラックといいます。

それに対し、幅優先探索とは、全ての可能性について一様に探索する手法です。 メモリーを消費し、比較的計算時間が長くかかりますが、 最初に見つかった経路が最短であることが保障されています。

また、両方の手法で、一度訪れた節を再び訪れないようにする必要があります。 そうしないとループにはまってしまいます。

2. 深さ優先探索

深さ優先探索のプログラムを書く場合、バックトラックをどのように表現するかが 問題になります。Haskell では、バックトラックを表現するのに mplus という総称関数を使います。 mplusclass MonadPlus に定義されていて、Maybe と List が MonadPlus の instance です。 Maybemplus は最初に現れた Just a を返し、List の mplus(++) です。 詳しくは Haskell 98 の 20.2 Class MonadPlus を見てください。

深さ優先探索のコードを以下に示します。

[code 1]

01:     -- easy search
02:     
03:     module EasySearch where
04:     
05:     import Monad
06:     
07:     type Graph = ([Int], [(Int, Int)])
08:                
09:     -- graph with loop
10:     gr0 :: Graph
11:     gr0 = ( [1,2,3,4,5,6,7,8,9],                                                        -- nodes
12:             [(1,2),(1,3),(1,4),(2,5),(3,5),(3,6),(4,7),(5,1),(6,7),(6,8),(7,9),(8,4)])  -- arrows
13:     
14:     find_next :: Int -> Graph -> [Int]
15:     find_next k gr = map snd  $ filter ((==k) . fst)  (snd gr)
16:     
17:     --------------------------------------------------------------------------
18:     -- depth first search
19:     --dfs :: Graph -> Int -> Int ->  Maybe [Int]                            
20:     dfs :: Graph -> Int -> Int ->  [[Int]]
21:     dfs gr p0 p1 = dfs_aux gr p0 p1 []
22:     
23:     dfs_aux gr p0 p1 path 
24:         | p0 == p1 = return (reverse (p1:path))
25:         | otherwise = msum $
26:                         map (\p -> dfs_aux gr p p1 (p0:path))
27:                            [ x | x <- find_next p0 gr, not (x `elem` path)]
[図 1]

説明
5 module Monad を import しています。このことによって class MonadPlus が使えるようになります。
7 ([Int], [(Int, Int)])Graph という別名をつけます。 以降、([Int], [(Int, Int)])と書く代わりに Graph と書くことが出来ます。Graph[Int], [(Int, Int)] の2つのリストからなる pair で、最初のリストは節、2番目は辺のリストです。
10--13 図1に示す構造を持つ有向グラフを定義します。
14--15 find_nextgr に含まれる節 k に隣接する節のリストを返します。
16--19 深さ優先探索を行う関数 dfs の型宣言です。Maybe [Int] を返すか、 [[Int]]を返すか選ぶことが出来ます。
21 dfs の定義があります。補助関数 dfs_aux を使って定義されています。
23--27 dfs_aux の定義です。dfs_aux の型宣言は明示的に行わず、処理系に任せます。
23 dfs_aux は4つの引数をとります。最初から順番に、グラフ (gr)、現在の節 (p0)、目的の節 (p1)、(降順の)たどってきた経路 (path) です。
24 もし、現在の節が目的の節と等しければ、経路 (reverse (p1:path)) を返します。
25 そうでなければ、p0 に隣接する節で、まだ、訪れていないもの ([ x | x <- find_next p0 gr, not (x `elem` path)]) のリストについて深さ優先探索 (dfs_axu) を map し、その結果を msum します。
msum の定義は Haskell 98 20. Monad にあり、以下のようになっています。

msum  :: MonadPlus m => [m a] -> m a
msum xs  =  foldr mplus mzero xs
mzero, mplus の定義は以下の通りです。
-- Instances of MonadPlus

instance  MonadPlus Maybe  where
    mzero                 = Nothing

    Nothing `mplus` ys    =  ys
    xs      `mplus` ys    =  xs

instance  MonadPlus []  where
    mzero =  []
    mplus = (++)
msum は以下のような動作をします。
msum [Nothin, Just 1, Just 2] ⇒ Just 1
msum [[], [1], [2]] ⇒ [1, 2]
実行結果を以下に示します。dfsMaybe [Int] を返す型の場合は最初に見つかった経路が、 [[Int]] の場合は全ての経路が返ってきます。 [code 1] の 19, 20 行目を入れ替えるだけで 得られる結果を変えることが出来ます。
-- dfs :: Graph -> Int -> Int ->  Maybe [Int] のとき
EasySearch> dfs gr0 1 9
Just [1,3,6,7,9]            -- 最初に見つかった経路を返す。

-- dfs :: Graph -> Int -> Int ->  [[Int]] のとき
EasySearch> dfs gr0 1 9
[[1,3,6,7,9],[1,3,6,8,4,7,9],[1,4,7,9]]  -- 見つかった経路全てのリストを返す。

3. 幅優先探索

幅優先探索では、探索する必要のある局面の待ち行列を使って探索を進めます。 具体的には、待ち行列の最初の局面をとり、
  1. その局面が終了条件を満たせば、 その局面までの経路と残りの探索を mplus します。
  2. そうでなければ、その局面から派生する局面を待ち行列の末尾に加えて探索を続けます。
コードを以下に示します。

[code 2]

01:     -- breadth first search
02:     bfs :: Graph -> Int -> Int -> [[Int]]
03:     --bfs :: Graph -> Int -> Int -> Maybe [Int]
04:     
05:     bfs gr p0 p1 = bfs_aux gr p1 [ x : [p0] | x <- find_next p0 gr] 
06:     
07:     bfs_aux _ _ [] = fail "no path"
08:     bfs_aux gr p1 (path:queue)
09:         | p0 == p1 =  (return (reverse path)) `mplus` (bfs_aux gr p1 queue)
10:         | otherwise = bfs_aux gr p1 ( queue ++
11:                                       [ x : path | x <- find_next p0 gr, not (x `elem` path)])
12:      where p0 = head path
2,3 行目で幅優先探索を行う関数 bfs の型を宣言します。
5 行目は bfs の定義です。 グラフ gr において、 p0 から p1 への経路は、
bfs_aux gr p1 [ x : [p0] | x <- find_next p0 gr]
で定義されます。
7--11 行目は bfs_aux の定義です。 bfs_aux はグラフ (gr)、 終点 (p1)、待ち行列の3つの 引数をとります。もし、待ち行列が空なら fail を返します。そうでなければ、 待ち行列の最初の項をとりだし、それの最初の項 (p0) が 終点 (p1) と等しければ経路を return し、 それと残りの探索を mplus します。 p0p1 が等しくなければ、待ち行列 (queue) に、p0 から派生する局面のリスト
([ x : path | x <- find_next p0 gr, not (x `elem` path)])
を加えて 探索を続けます。

実行例を以下に示します。dfs の場合と同様に、 bfs の型によって、返る値が違ってきます。

-- bfs :: Graph -> Int -> Int ->  Maybe [Int] のとき
EasySearch> bfs gr0 1 9
Just [1,4,7,9]                -- 最短経路を返す。

-- bfs :: Graph -> Int -> Int ->  [[Int]] のとき
EasySearch> bfs gr0 1 9
[[1,4,7,9],[1,3,6,7,9],[1,3,6,8,4,7,9]]    -- 見つかった経路全てのリストを短い順に返す。
これらのことから、Monad を使えば、Maybe 型と List 型は全く同じに取り扱える ことが分かります。つまり、List の Monad が定義されていることによって、 コードの再利用が促進されます。

4. 三夫婦の川渡り問題

探索問題の実際例として、三夫婦の川渡り問題を考えます。

一般に川渡り問題というのは、 2人乗り(N>2 人乗りの場合もある)のボートを用いて、許されない組み合わせを回避しながら全員を対岸に渡す際の 最短経路を求める問題です。

三夫婦の川渡り問題の場合は、夫がいないときに妻が他の男といるのは許されないと いう制約がつきます。

最短経路を求める問題なので、幅優先探索で解くことにします。 プログラムを容易にするために、3人の夫に正の整数 1,2,3 の、 彼らの妻に絶対値が等しい負の整数 -1, -2, -3 の番号をつけます。

さらに、3組の夫婦が等価であることを利用して探索する局面の 数を減らします。3組の夫婦は等価なので、岸の状態は、夫の人数、妻の人数、夫婦の数、 ボートの有無のみで区別され、どの夫婦がいるかは経路を求める際に考慮する必要はありません。 data 型 River を定義し、 上で述べた方針で River の Eq を定義します。こうすると 探索する局面の数が著しく減少します。

コードを以下に示します。

[code 3]

01:     ---------------------------------------------------------------------------
02:     -- river_cross.hs
03:     --       by T.Shido (shido_takafumi@ybb.ne.jp)
04:     --
05:     -- Getting one of the shortest path for the river crossing puzzle of three couples:
06:     -- three couples are going to cross a river using a boat under following conditions.
07:     -- 1) the boat is two-seated
08:     -- 2) All wives should be with their husbands if other men are with them.
09:     --
10:     -- In this program, the husbands are represented by 1, 2, and 3, and
11:     -- their wives are by -1, -2, and -3. 
12:     -----------------------------------------------------------------------------
13:     
14:     module Main where
15:     
16:     import List
17:     
18:     data River = River {
19:                           this :: [Int],         -- the river side where people are at the beginning
20:                           that :: [Int],         -- the river side where people are at the end
21:                           boat :: Bool           -- if the boat is at `this' 
22:                        } deriving Show
23:     
24:     -- 
25:     instance Eq River where
26:         r1 == r2 = n_hus this1 == n_hus this2 &&
27:                    n_wif this1 == n_wif this2 &&
28:                    n_cop this1 == n_cop this2 &&
29:                    boat r1 == boat r2
30:          where this1 = this r1
31:                this2 = this r2
32:     
33:     ----
34:     n_hus :: [Int] -> Int
35:     n_hus = length . (filter (>0))
36:     
37:     n_wif :: [Int] -> Int
38:     n_wif = length . (filter (<0))
39:     
40:     n_cop :: [Int] -> Int
41:     n_cop [] = 0
42:     n_cop (x:xs) = (if (negate x) `elem` xs then 1 else 0) + n_cop xs
43:     
44:     ---
45:     remove_couple :: [Int] -> [Int]
46:     remove_couple [] = []
47:     remove_couple (x:xs) = if elem x' xs 
48:                                then remove_couple (delete x' xs)
49:                                else x : (remove_couple xs)
50:      where x' = negate x
51:     
52:     --- check if the river situation is safe
53:     safe :: River -> Bool
54:     safe' :: [Int] -> Bool
55:     
56:     safe river = safe' (this river) && safe' (that river) 
57:     safe' ls =  all (<0) ls || all (>0) (remove_couple ls)
58:     
59:     --- breadth first search for river crossing
60:     river_bfs :: [River] -> [[River]] -> [River]
61:     river_bfs _ [] = []
62:     river_bfs track (path:qs)
63:         | this now == [] = reverse path
64:         | otherwise = river_bfs (now:track)
65:                          (qs ++ [ next:path | next <- update_river now, next `notElem` track])
66:      where now = head path
67:     
68:     --- return the list of possible situation
69:     update_river :: River -> [River]
70:     update_river = nub . (filter safe) . choices
71:     
72:     --- return the list of next river situation
73:     choices :: River -> [River]
74:     choices river = [ River{
75:                              this = (if boat river then (\\) else (++)) (this river) x,
76:                              that = (if boat river then (++) else (\\)) (that river) x,
77:                              boat = not (boat river)}
78:                            | x <- group ls0 ++                 -- x is people who ride boat.
79:                                   filter safe' [[x, y] | x <- ls0, y <- (fst . (break (==x))) ls0]]  
80:      where ls0 = (if boat river then this else that) river
81:     
82:     ---
83:     main :: IO()
84:     main =  mapM_ print (river_bfs [] [[River{ this = [-3,-2,-1,1,2,3],
85:                                                that = [],
86:                                                boat = True }]])
簡単な説明
説明
14 module List を import する。List 用の種種の関数が使えるようになる。
18--22 data River を名前付きフィールドを用いて定義する。 this は初めの岸にいる人のリスト、that は向こう岸にいる人のリストboat はボートが 初めの岸にあれば True。
25--31 data River の Eq を定義する。this の夫、妻、夫婦の数が等しく、boat が 等しければ2つの River は等しい。
34--35 夫の数を求める。
37--38 妻の数を求める。
40--42 夫婦の数を求める。
45--50 リストから夫婦を取り除いたリストを返す。
remove_couple [-1,1,2,3] ⇒ [2,3]
54,57 引数が許容される組み合わせであるか調べる。許容されれば True
53,56 River が許容される常態か調べる。
60--66 幅優先探索を行う。最短経路を返すだけなら Monad を使う必要はない。
river_bfs は探索した局面のリスト (track) と経路の待ち行列の 2つの引数を取る。待ち行列が [] なら [] を返す。 待ち行列が (path:qs) なら、
  1. もし、元の岸に誰もいなかったら (this now == []) 経路 (reverse path) を返す。
  2. そうでなかったら、now から生成する局面 (next) で、まだ探索されていないもの (next `notElem` track) を待ち行列の末尾に加え、探索を繰り返す。
ここで now は head path である。
69--70 River の局面から次の可能な局面を生成して返す。
まず、choices でボートを動かすことによって生成する全ての局面を生成し、 それを safe を使って filtering する。さらに、nub で等価な局面を取り除く。
73--80 ボートを動かすことによって生成する全ての River を返す。 ボートが初めの岸にあれば、this から、向こう岸にあれば that から 許容される組み合わせの1人か2人選んで対岸に渡す。
(\\) は2つの引数の差集合を返す。 [1,2,3] \\ [1] ⇒ [1,2]
group は引数の要素をリストにして返す。 group [1,2,3] ⇒ [[1], [2], [3]]
つまり、group ls0 はボートに1人乗っている場合、
filter safe' [[x, y] | x <- ls0, y <- (fst . (break (==x))) ls0]
はボートに2人乗っている場合である。
83--86 main 関数。mapM_ print で結果を表示。

実行例: 11 ステップで渡河が完了します。

D:\doc\05-04\hs>runhugs river_cross.hs
River{this=[-3,-2,-1,1,2,3],that=[],boat=True}   -- initial, step 0
River{this=[-3,1,2,3],that=[-1,-2],boat=False}
River{this=[-2,-3,1,2,3],that=[-1],boat=True}
River{this=[1,2,3],that=[-3,-2,-1],boat=False}
River{this=[-1,1,2,3],that=[-3,-2],boat=True}
River{this=[-1,1],that=[3,2,-3,-2],boat=False}
River{this=[-2,2,-1,1],that=[3,-3],boat=True}
River{this=[-2,-1],that=[1,2,3,-3],boat=False}
River{this=[-3,-2,-1],that=[1,2,3],boat=True}
River{this=[-3],that=[-1,-2,1,2,3],boat=False}
River{this=[-2,-3],that=[-1,1,2,3],boat=True}
River{this=[],that=[-3,-2,-1,1,2,3],boat=False}  -- final, step 11
気が向いたら、このプログラムを改造して、 宣教師と人食い人種版を作ってみてください。 禁制条件がシンプルなのでプログラムはむしろ短くなります。

5. 終わりに

この文章では、List に Monad があると探索(特に深さ優先探索)に便利な ことを説明しました。また、探索問題の実際的?な例として、三夫婦の 川渡り問題を取り上げました。 付録にコードがありますので気が向いたら遊んでみてください。

探索問題については

  1. Depth first search と Breadth first search
  2. Breadth First Search/Depth First Search Animations
などを見てください。

また、 川渡り問題については

  1. 川渡りパズル研究
を見て下さい。