import Monad
maze = ["**************************",
"*S* * *",
"* * * * ************* *",
"* * * ************ *",
"* * *",
"************** ***********",
"* *",
"** ***********************",
"* * G *",
"* * *********** * *",
"* * ******* * *",
"* * *",
"**************************"]
type Pos = (Int,Int)
type Path = [Pos]
findPos :: [String] -> Char -> Pos
findPos mz c =
let y = findY mz c 0
x = findX (mz!!y) c 0
in (x,y)
where
findY :: [String] -> Char -> Int -> Int
findY [] _ _ = error (c : " not found\n")
findY (x:xs) c n | c `elem` x = n
| otherwise = findY xs c (n+1)
findX :: String -> Char -> Int -> Int
findX (x:xs) c n | x == c = n
| otherwise = findX xs c (n+1)
canMove :: [String] -> Pos -> Bool
canMove mz (x,y) | mz !! y !! x == '*' = False
| otherwise = True
nextSteps :: [String] -> Pos -> [Pos]
nextSteps mz (x,y) = filter (canMove mz) [(x-1,y),(x+1,y),(x,y-1),(x,y+1)]
getAllPaths :: [String] -> Pos -> Pos -> [Path]
getAllPaths mz st gl = getPath mz gl [ x : [st] | x <- nextSteps maze st]
getPath :: [String] -> Pos -> [Path] -> [Path]
getPath _ _ [] = fail "no Path"
getPath mz p1 ap@(path:queue)
| p0 == p1 = (return (reverse path)) `mplus` (getPath mz p1 queue)
| otherwise = getPath mz p1 ( queue ++ [ x : path | x <- nextSteps mz p0, not (or (map (x `elem`) ap))])
where p0 = head path
start = findPos maze 'S'
goal = findPos maze 'G'
allpath = getAllPaths maze start goal
path全体で一度通った位置を再度通らないようにしないと終わらなかった。