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

いただいたアドバイス (id:rst76:20100115:1263567265) を拝読し、自前実装に取り込んでみた。
コードははしょるけれど、解を Maybe から List にして盤面探索すると以下のふたつしか見つからない:

**************************
*S* *$$$$                *
*$* *$ *$ *************  *
*$*$$$* $  ************  *
*$$$ *  $$$$$$$          *
**************$***********
* $$$$$$$$$$$$$          *
**$***********************
* $$$  *$$$$$$$$$$$$$$G  *
*  *$$$$$ *********** *  *
*    *        ******* *  *
*       *                *
**************************

**************************
*S* *$$$$                *
*$* *$ *$ *************  *
*$*$$$* $  ************  *
*$$$ *  $$$$$$$          *
**************$***********
* $$$$$$$$$$$$$          *
**$***********************
* $$$  *              G$ *
*  *$$$   *********** *$ *
*    *$$$$    ******* *$ *
*       *$$$$$$$$$$$$$$$ *
**************************

既訪の位置を記憶していることが原因だとはわかるのだけれど、これがなかなか解決できず思案中。
何手目にそこに訪れたかを覚えておけばいいとおもって以下のコードを書いたのだけれど、これは訪問済みを覚える前とおなじコードになっている疑惑。何をどうやって除外しているのか、もういちど冷静に考えることにする。

import Control.Monad

type Depth     = Int
type Cordinate = (Int, Int)
type Position  = (Depth, Cordinate)
type Board     = [String]
type State     = (Position, Board)

main :: IO ()
main = do
  input <- fmap lines getContents
  let answer = solve [] $ (next.from) input
  putStrLn $ unlines $ map unlines $ take 10 answer

solve :: [Position] -> [State] -> [Board]
solve _ [] = mzero
solve vs ((p@(d,c),b):queue)
  | on 'G'                = return b `mplus` solve vs queue
  | on ' ' && before p vs = solve (p:vs) (queue ++ (next.modify) (p,b))
  | otherwise             = solve vs queue
 where on = (b!!snd c!!fst c ==)
       before (d,c) vs = notElem c $ map snd $ filter ((< d).fst) vs

next :: State -> [State]
next ((d,(x,y)),b) = zip ns (repeat b)
  where ns = [(d+1,p) | p <- [(x,y-1),(x,y+1),(x-1,y),(x+1,y)]]

from :: Board -> State
from input = (startOf input, input)

startOf :: Board -> Position
startOf input = head [(0,(x,y)) |
  (y,cs) <- zip [0..] input, (x,c) <- zip [0..] cs, c=='S']

modify :: State -> State
modify ((d,c@(x,y)),b) = ((d,c), putAt y (putAt x '$' (b!!y)) b)
  where putAt n v vs = take n vs ++ v : drop (n+1) vs

つまり以下のような盤面に対して…

*****
*S  *
*   *
*  G*
*****

以下のような可能性をぜんぶ列挙できるようにしたい。そんなに難しいとはおもえないのに、なんでできないかなあ。

*****
*S$$*
*  $*
*  G*
*****
*****
*S$ *
* $$*
*  G*
*****
*****
*S$ *
* $ *
* $G*
*****
*****
*S  *
*$$$*
*  G*
*****
*****
*S  *
*$$ *
* $G*
*****
*****
*S  *
*$  *
*$$G*
*****