Life Goes On

まあまあだけど楽しんでる方です

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