BFS
「人材獲得作戦・4 試験問題ほか」を解こうとしている(続・未完) - IKB: 雑記帖 について、コメント欄に書こうと思ったのですが、長くなったのでこちらに。
この場合、遅延評価云々はあまり関係なくて、元エントリのコードでも解が一つ見つかった時点ですぐに返ってきます。
ただこの迷路は自由度が大きいので、やはり既訪の場所を除外しないと何度も同じところを通ってしまいます。
例えば A : 1→2→3→4、B : 1→2→5→3 というような順序で探索する(2 のノードで分岐する)とき B の方では 3 のノードが既訪だということが分からないので、再探索してしまいます。
これを除外するためには探索の分岐に関わらず既訪のノードを記憶しておく必要があって、以下のコードでは solve の引数を追加しています。
その他、細かいところをちょこちょこいじってますが、ご参考まで。(Maybe にしたら mplus の意味がなくなってしまった)
import Control.Monad type Position = (Int, Int) type Board = [String] type State = (Position, Board) main :: IO () main = do input <- fmap lines getContents let answer = solve [] $ next (startOf input, input) putStrLn $ maybe "no route found" unlines answer startOf :: Board -> Position startOf input = head [(x,y) | (y,cs) <- zip [0..] input, (x,c) <- zip [0..] cs, c=='S'] solve :: [Position] -> [State] -> Maybe Board solve _ [] = mzero solve vs ((p@(x,y), b) : queue) | symbol=='G' = return b `mplus` solve vs queue | symbol==' ' && notElem p vs = solve (p:vs) $ queue ++ next (p, b) | otherwise = solve vs queue where symbol = b!!y!!x next :: State -> [State] next ((x,y), b) = zip [(x,y-1), (x,y+1), (x-1,y), (x+1,y)] $ repeat b' where b' = putAt y (putAt x '$' $ b!!y) b putAt n v vs = take n vs ++ v : drop (n+1) vs