Search
このコードにいたく感心したので、探索について考えた。
dfs :: (a -> [a]) -> a -> [a] dfs f x = x:(f x >>= dfs f)bfs :: (a -> [a]) -> a -> [a] bfs f = bfs' . (:[]) where bfs' xs = xs ++ bfs' (xs >>= f)http://www.lab2.kuis.kyoto-u.ac.jp/~hanatani/tdiary/?date=20050107
シンプルで美しいdepth first searchとbreadth first searchであると思う。
しかし、探索とはいっても、これは一列に展開しているだけだ。
実際にある条件をみたすものを見付けたい場合には、
[ x | x <- bfs components graph, condition x ]
のように使うことになる。
リストは、非決定性をあらわすモナドである。
do x <- bfs components graph
if condition x then return x else mzero実は、一列に並べることではなくて、非決定的なモナドを作ることが探索という行為の本質なのではないか*1 *2。
そう考えて書き直すとこうなる。
dfs f x = return x `mplus` (f x >>= dfs f) bfs f = bfs' . return where bfs' xs = xs `mplus` bfs' (xs >>= f)
型はどちらももちろん
*Main> :t bfs
bfs :: forall a (m :: * -> *).
(MonadPlus m) =>
(a -> m a) -> a -> m a
*Main>である。
さて、このように思考をすすめてくると
続く
続き
componentsをとってくるfはすでにMonadicな関数であることに気づく。
このように探索アルゴリズムと状態操作を混ぜなくても、
State モナドを使って探索で同じところを廻らないようにする。
bfs f x = evalState (bfs' [x]) emptySet where bfs' [] = return [] bfs' (x:xs) = do st <- get if x `elementOf` st then bfs' xs >>= return else put (addToSet st x) >> bfs' (xs ++ f x) >>= return . (x:) dfs f x = evalState (dfs' [x]) emptySet where dfs' [] = return [] dfs' (x:xs) = do st <- get if x `elementOf` st then dfs' xs >>= return else put (addToSet st x) >> dfs' (f x ++ xs) >>= return . (x:)http://www.lab2.kuis.kyoto-u.ac.jp/~hanatani/tdiary/?date=20050112#p02
fは状態を構成される探索モナドそのものからとってこれるはずである。
fだけではなく、無条件に生成されている先頭部分にもモナドによる操作が行えるようにしよう。actという引数を付け加える。
dfsM f act x = act x `mplus` (f x >>= dfs f)
bfsM f act = bfsM' . return where bfsM' xs = (xs >>= act) `mplus` bfsM' (xs >>= f)
オリジナルのコードはこうかける。
dfs, bfs :: (a -> [a]) -> a -> [a] dfs = gens dfsM bfs = gens bfsM gens s f = s f return
同じ所を廻らないためのコードはこうなる。探索のために作るモナドはListT (State (Set a))である。
dfsMem f = gens_mem dfsM f
bfsMem f = gens_mem bfsM f
gens_mem search f = flip evalState empty . runListT
. search span filt
where
span x = filt x >>= add >> (msum . map return . f) x
filt x = do guard =<< return . not . (x `elemOf`) =<< get
return x-- sample empty = [] elemOf = elem add x = modify (x:)
しかし
実は上のbfsは停止しないのだ。もとのこのコードからして、
bfs f = bfs' . (:[]) where bfs' xs = xs ++ bfs' (xs >>= f)
bfs' [] = [] ++ bfs' []
となって、これは、残念ながら、[]とは等しくない。
停止させるためには、
bfs f = bfs' . (:[])
where
bfs' [] = []
bfs' xs = xs ++ bfs' (xs >>= f)と、空リストの場合を特別に扱う必要がある*3。
ところが、bfsM' の引数は一般のモナドであるから、mzeroであるかどうかを知る方法は無いのだ。いや、あるのだけれども、実際に走らせてみる他には無いのだ。
bfsM span act = bfsM' . return
where
bfsM' xs = (xs >>= act) `mplus` (xs >> bfsM' (xs >>= span))これで停止はするけれども、問題がある。
- xs は 二回走る (bfsMem では結果に影響しない)
- xs が mzero でなかったときに(つまり「大体いつも」)メモリリークする
bfsMはきれいにかけるだろうか？
補遺
昨日途中でやめたのはいくつか引っかかることがあるためだ。あきらめて続きを書いたけれども。
- bfsMはおかしい。
- dfsM/bfsMの引数actは外に出したい。遅延評価のmapやfilterのように。*4
追記(2005-01-14)
ListTに制限すればこれでOK。
bfsLTM span act = bfs' . return
where
bfs' xs = zero_stop_mplus xs act (bfs' (xs >>= span))
zero_stop_mplus x act y
= ListT $ do a <- runListT x
if null a then return [] else do
b <- mapM (runListT . act) a
c <- runListT y
return $ concat b ++ cどのみちListTでないとdepth firstとかbreadth firstにならない(かもしれない)のだからこれもいいか。
Monad Transformer Library suffers from sever lack of documentation!
*2:モナドである以上は(必要条件として)一列に並ばざるを得ないが
*3:追記:補遺として花谷さんも書かれましたhttp://www.lab2.kuis.kyoto-u.ac.jp/~hanatani/tdiary/?date=20050114#p01
*4:追記:リスト生成と選択を分離できるのが遅延評価の利点だという花谷さんの指摘http://www.lab2.kuis.kyoto-u.ac.jp/~hanatani/tdiary/?date=20050114#p03には全く同意します
