Tree Monad
探索とは、まず解の候補を葉とする木を作って*1、それからその木の枝をあるアルゴリズムで辿って解を発見することである*2。
リストによるバックトラックを利用した探索は、木を作る端から全部フラットにして深さ優先探索をしているのである。
探索アルゴリズムを分離して、探索木だけをモナドにしてしまおう。
例えば、引数mkでモナドを切替えられる探索木生成関数
test01 mk
= do x <- mk [1, 2]
if x == 2 then return 100 else do
y <- mk [3,3]
return yは、リストだと
*Monad.TestTree> take 5 $ test01 id [3,3,100]
と深さ優先探索する。これから作るTree monadだとこのように探索方法を後で選択できる。
*Monad.TestTree> take 5 $ runBfs $ test01 mkNode [100,3,3] *Monad.TestTree> take 5 $ runDfs $ test01 mkNode [3,3,100]
さて、実装しよう。分岐をNode [Tree a]であらわし、解候補はLeafとしてあらわす。
data Tree a = Node [Tree a] | Leaf a deriving (Show, Eq, Ord)
モナドとしての定義はこうである。
instance Monad Tree where (Node cs) >>= f = Node $ map (>>= f) cs Leaf a >>= f = f a return = Leaf fail _ = Node []
モナドの定義を満たしているか確認する。
* Monad Laws
1. (return x) >>= f == f x
* Leaf x >>= f = f x
2. m >>= return == m
* Leaf a >>= return == Leaf a
* Node xs >>= return
= Node $ map (>>= return cs) -- あとは帰納法
3. (m >>= f) >>= g == m >>= (\x -> f x >>= g)
* (Node cs >>= f) >>= g
= Node (map (>>= f) cs) >>= g
= Node (map (>>= g) . map (>>= f) $ cs)
= Node (map ((>>= g) . (>>= f)) $ cs)
= Node (map (\x -> f x >>= g)) $ cs)
= Node cs >>= (\x -> f x >>= g)
* (Leaf a >>= f) >>= g
= f a >>= g
= Leaf a >>= (\x -> f x >>= g)二つの探索木から新しい探索木を作れるようにしたい。
MonadPlusのインスタンスにしてみよう。
instance MonadPlus Tree where
mzero = Node []
ta `mplus` tb = case (ta, tb) of
(Leaf a, Leaf b) -> Node [ta, tb]
(Leaf a, Node cs) -> Node $ ta:cs
(Node cs, Leaf a) -> Node $ cs ++ [tb]
(Node cs1, Node cs2) -> Node $ cs1 ++ cs2これは次の条件をみたしているだろうか？
* MonadPlus Laws 1. mzero >>= f == mzero 2. m >>= (\x -> mzero) == mzero 3. mzero `mplus` m == m 4. m `mplus` mzero == m
一見満たしていない
Node [Leaf a] >>= (\x -> mzero) = Node [Node []]
のだが、この違いは、深さ優先探索および幅優先探索には影響を与えない。したがって、このモナドへのアクセスをそれらに制限する限りにおいては、MonadPlusのインスタンスになっている*3 *4。
最後に、探索アルゴリズム二つを実装しておく。
-- | Depth first search runDfs :: MonadPlus m => Tree a -> m a runDfs = msum . map valueM . dfs expand -- | Breadth first search runBfs :: MonadPlus m => Tree a -> m a runBfs = msum . map valueM . bfs expand
runDfs/runBfsで使った関数の定義:
valueM :: Monad m => Tree a -> m a
valueM (Node _) = fail "not Leaf"
valueM (Leaf a) = return a
expand (Node cs) = cs
expand (Leaf a) = []
dfs f x = x:(f x >>= dfs f)
bfs f = bfs' . (:[])
where
bfs' [] = []
bfs' xs = xs ++ bfs' (xs >>= f)今回作ったmodule。
TODO
- Monad Transformer
- RoseTree (Maybe a) ?
