{-# OPTIONS_GHC -Wall #-}
import Control
.Monad (guard
) import Control.Applicative ((<$>))
import Data.Array (Array, listArray, assocs, (!), elems, (//))
data Direction
= E
| W
| S
| N
deriving (Show, Eq) data MapData
= MapData
{mapData
:: Array Pos Tile
, height
:: Int, width
:: Int}
strToMapData h w input
= MapData
(listArray
((0,0), (h
,w
)) $ filter (/='\n') input
) h w
printMapData
:: MapData
-> IO ()printMapData (MapData m _ w) = do
printMapData' w $ elems m
where
printMapData' _ "" = return ()
printMapData' w' s = do
putStrLn $ take w' s
printMapData
' w' $ drop w
' s
startPos :: MapData -> Pos
startPos = posOf 'S'
where
posOf :: Tile -> MapData -> Pos
posOf tile (MapData ar _ _) = fst $ head $ filter (\(_,t) -> t == tile) $ assocs ar
-- | 指定した位置から移動した次の位置のリストを返す (壁'*'には移動できない)
nextPoss :: MapData -> Pos -> [Pos]
nextPoss (MapData m h w) p = do
(y',x') <- (move p) <$> [E,W,S,N]
guard $ (y' >= 0) && (y' < h) && (x' >= 0) && (x' < w)
guard $ (m ! (y',x')) /= '*'
return (y',x')
-- | 1マス移動する
move :: Pos -> Direction -> Pos
move (y,x) E = (y,x+1)
move (y,x) W = (y,x-1)
move (y,x) S = (y+1,x)
move (y,x) N = (y-1,x)
-- | ゴールに到達する経路をすべて返す (ただし一度通ったところは通らない)
searchRoute :: MapData -> [Pos] -> Pos -> [[Pos]]
searchRoute m tracks currentP = do
if ((mapData m) ! currentP) == 'G'
then return tracks
else if currentP `elem` tracks
then []
else do
nextP <- nextPoss m currentP
searchRoute m (currentP:tracks) nextP
-- | ゴールへの最短経路を返す
shortestRoute :: MapData -> Maybe [Pos]
shortestRoute mData =
let routes = searchRoute mData [] $ startPos mData
minLen = minimum $ map length routes
minRoutes = filter (\r -> length r == minLen) routes
in if length minRoutes == 0 then Nothing else Just $ head minRoutes
-- | マップに経路を重ねる
mergeRoute :: MapData -> [Pos] -> MapData
mergeRoute (MapData m h w) route = MapData (m // init (map (\p -> (p,'$')) $ route)) (h+1) (w+1)
main :: IO ()
main = do
c <- getContents
let h = length $ lines c
w = length $ head $ lines c
mData = strToMapData (h-1) (w-1) c
case shortestRoute mData of
Just route -> printMapData $ mergeRoute mData $ route
Nothing -> error "There is no route."
ey0jIE9QVElPTlNfR0hDIC1XYWxsICMtfQppbXBvcnQgQ29udHJvbC5Nb25hZCAoZ3VhcmQpCmltcG9ydCBDb250cm9sLkFwcGxpY2F0aXZlICgoPCQ+KSkKaW1wb3J0IERhdGEuQXJyYXkgKEFycmF5LCBsaXN0QXJyYXksIGFzc29jcywgKCEpLCBlbGVtcywgKC8vKSkKCmRhdGEgRGlyZWN0aW9uID0gRSB8IFcgfCBTIHwgTiBkZXJpdmluZyAoU2hvdywgRXEpCnR5cGUgUG9zID0gKEludCxJbnQpIC0tICh5LHgpCnR5cGUgVGlsZSA9IENoYXIKZGF0YSBNYXBEYXRhID0gTWFwRGF0YSB7bWFwRGF0YSA6OiBBcnJheSBQb3MgVGlsZSwgaGVpZ2h0IDo6IEludCwgd2lkdGggOjogSW50fQoKc3RyVG9NYXBEYXRhIDo6IEludCAtPiBJbnQgLT4gU3RyaW5nIC0+IE1hcERhdGEKc3RyVG9NYXBEYXRhIGggdyBpbnB1dCA9IE1hcERhdGEgKGxpc3RBcnJheSAoKDAsMCksIChoLHcpKSAkIGZpbHRlciAoLz0nXG4nKSBpbnB1dCkgaCB3CgpwcmludE1hcERhdGEgOjogTWFwRGF0YSAtPiBJTyAoKQpwcmludE1hcERhdGEgKE1hcERhdGEgbSBfIHcpID0gZG8KICBwcmludE1hcERhdGEnIHcgJCBlbGVtcyBtCiAgd2hlcmUKICAgIHByaW50TWFwRGF0YScgOjogSW50IC0+IFN0cmluZyAtPiBJTyAoKQogICAgcHJpbnRNYXBEYXRhJyBfICIiID0gcmV0dXJuICgpCiAgICBwcmludE1hcERhdGEnIHcnIHMgPSBkbwogICAgICBwdXRTdHJMbiAkIHRha2UgdycgcwogICAgICBwcmludE1hcERhdGEnIHcnICQgZHJvcCB3JyBzCgpzdGFydFBvcyA6OiBNYXBEYXRhIC0+IFBvcwpzdGFydFBvcyA9IHBvc09mICdTJwogIHdoZXJlCiAgICBwb3NPZiA6OiBUaWxlIC0+IE1hcERhdGEgLT4gUG9zCiAgICBwb3NPZiB0aWxlIChNYXBEYXRhIGFyIF8gXykgPSBmc3QgJCBoZWFkICQgZmlsdGVyIChcKF8sdCkgLT4gdCA9PSB0aWxlKSAkIGFzc29jcyBhcgoKLS0gfCDmjIflrprjgZfjgZ/kvY3nva7jgYvjgonnp7vli5XjgZfjgZ/mrKHjga7kvY3nva7jga7jg6rjgrnjg4jjgpLov5TjgZkgKOWjgScqJ+OBq+OBr+enu+WLleOBp+OBjeOBquOBhCkKbmV4dFBvc3MgOjogTWFwRGF0YSAtPiBQb3MgLT4gW1Bvc10KbmV4dFBvc3MgKE1hcERhdGEgbSBoIHcpIHAgPSBkbwogICh5Jyx4JykgPC0gKG1vdmUgcCkgPCQ+IFtFLFcsUyxOXQogIGd1YXJkICQgKHknID49IDApICYmICh5JyA8IGgpICYmICh4JyA+PSAwKSAmJiAoeCcgPCB3KQogIGd1YXJkICQgKG0gISAoeScseCcpKSAvPSAnKicKICByZXR1cm4gKHknLHgnKQoKLS0gfCDvvJHjg57jgrnnp7vli5XjgZnjgosKbW92ZSA6OiBQb3MgLT4gRGlyZWN0aW9uIC0+IFBvcwptb3ZlICh5LHgpIEUgPSAoeSx4KzEpCm1vdmUgKHkseCkgVyA9ICh5LHgtMSkKbW92ZSAoeSx4KSBTID0gKHkrMSx4KQptb3ZlICh5LHgpIE4gPSAoeS0xLHgpCgotLSB8IOOCtOODvOODq+OBq+WIsOmBlOOBmeOCi+e1jOi3r+OCkuOBmeOBueOBpui/lOOBmSAo44Gf44Gg44GX5LiA5bqm6YCa44Gj44Gf44Go44GT44KN44Gv6YCa44KJ44Gq44GEKQpzZWFyY2hSb3V0ZSA6OiBNYXBEYXRhIC0+IFtQb3NdIC0+IFBvcyAtPiBbW1Bvc11dCnNlYXJjaFJvdXRlIG0gdHJhY2tzIGN1cnJlbnRQID0gZG8KICBpZiAoKG1hcERhdGEgbSkgISBjdXJyZW50UCkgPT0gJ0cnCiAgICAgdGhlbiByZXR1cm4gdHJhY2tzCiAgICAgZWxzZSBpZiBjdXJyZW50UCBgZWxlbWAgdHJhY2tzCiAgICAgICAgICAgIHRoZW4gW10KICAgICAgICAgICAgZWxzZSBkbwogICAgICAgICAgICAgIG5leHRQIDwtIG5leHRQb3NzIG0gY3VycmVudFAKICAgICAgICAgICAgICBzZWFyY2hSb3V0ZSBtIChjdXJyZW50UDp0cmFja3MpIG5leHRQCgotLSB8IOOCtOODvOODq+OBuOOBruacgOefree1jOi3r+OCkui/lOOBmQpzaG9ydGVzdFJvdXRlIDo6IE1hcERhdGEgLT4gTWF5YmUgW1Bvc10Kc2hvcnRlc3RSb3V0ZSBtRGF0YSA9CiAgbGV0IHJvdXRlcyA9IHNlYXJjaFJvdXRlIG1EYXRhIFtdICQgc3RhcnRQb3MgbURhdGEKICAgICAgbWluTGVuID0gbWluaW11bSAkIG1hcCBsZW5ndGggcm91dGVzCiAgICAgIG1pblJvdXRlcyA9IGZpbHRlciAoXHIgLT4gbGVuZ3RoIHIgPT0gbWluTGVuKSByb3V0ZXMKICBpbiBpZiBsZW5ndGggbWluUm91dGVzID09IDAgdGhlbiBOb3RoaW5nIGVsc2UgSnVzdCAkIGhlYWQgbWluUm91dGVzCgotLSB8IOODnuODg+ODl+OBq+e1jOi3r+OCkumHjeOBreOCiwptZXJnZVJvdXRlIDo6IE1hcERhdGEgLT4gW1Bvc10gLT4gTWFwRGF0YQptZXJnZVJvdXRlIChNYXBEYXRhIG0gaCB3KSByb3V0ZSA9IE1hcERhdGEgKG0gLy8gaW5pdCAobWFwIChccCAtPiAocCwnJCcpKSAkIHJvdXRlKSkgKGgrMSkgKHcrMSkKCm1haW4gOjogSU8gKCkKbWFpbiA9IGRvCiAgYyA8LSBnZXRDb250ZW50cwogIGxldCBoID0gbGVuZ3RoICQgbGluZXMgYwogICAgICB3ID0gbGVuZ3RoICQgaGVhZCAkIGxpbmVzIGMKICAgICAgbURhdGEgPSBzdHJUb01hcERhdGEgKGgtMSkgKHctMSkgYwogIGNhc2Ugc2hvcnRlc3RSb3V0ZSBtRGF0YSBvZgogICAgSnVzdCByb3V0ZSAtPiBwcmludE1hcERhdGEgJCBtZXJnZVJvdXRlIG1EYXRhICQgcm91dGUKICAgIE5vdGhpbmcgLT4gZXJyb3IgIlRoZXJlIGlzIG5vIHJvdXRlLiIK