「人材獲得作戦・４ 試験問題ほか」を解こうとしている（続・未完）

昨日 (d:id:i_k_b:20100113:1263400645) の続き。
探索問題なんだ、ということで検索してかつて読んで感動したページ「Search using Haskell」を再発見。
これを参考に書き直したコードが以下:

import Data.List
import Monad

main = do
  cs <- getContents
  let input  = lines cs
  let answer = solve $ (next.from) input
  putStrLn $ unlines $ head $ answer

from input = (startOf input, input)

startOf x = fst $ head $ filter ((=='S').snd) x'  where
  x' = concatMap (\(y,cs) -> zip (zip [0..] (repeat y)) cs) (zip [0..] x)

solve [] = fail "no route found"
solve ((p,b):queue)
  | symbol == ' ' = solve (queue ++ (next.modify) (p,b))
  | symbol == 'G' = return b `mplus` (solve queue)
  | otherwise     = solve queue
  where symbol = b!!(snd p)!!(fst p)

modify ((x,y),b) = ((x,y), putAt y (putAt x '$' (b!!y)) b)
putAt n v vs = take n vs ++ v : drop (n+1) vs
inner  ((x,y),b) = x >= 0 && y >= 0 && x < length (head b) && y < length b
next = (filter inner) . move

move (p,b) = zip [up p, dn p, lt p, rt p] (repeat b)  where
  up (x,y) = (x,y-1)
  dn (x,y) = (x,y+1)
  lt (x,y) = (x-1,y)
  rt (x,y) = (x+1,y)

MonadPlus を使ってリストにしたから、見つかったら即結果を出してくれる…はず。…あんまり関係ないのかなあ？
また結果をひとつだけ返せばいいのだから main 関数の最後のアクション putStrLn $ unlines $ head $ answer では、リストに対する head でなく Maybe に対する fromJust にすればよい、気がする。

既訪の場所に来たらこれを落とす処理は、入れた方がいいのかしらん？おぼろげにだけれど入れなくても大丈夫な気がしている。というのは、動ける場所を $ に書き換えているから訪問済みの場所には入れないはず、というおぼろげな根拠による。

結果…（涙）

スタックオーバーフローですと…？

$ time cat map | runghc solver.hs 

Stack space overflow: current size 8388608 bytes.
Use `+RTS -Ksize' to increase it.

real    56m45.980s
user    55m20.357s
sys     0m16.283s