ICPC
http://www.acm-japan.org/past-icpc/domestic2006/contest/all_ja.html の Problem D。
非常にめんどくさかった。しかも長いし汚い。
import System import Data.Array import Data.Maybe import Control.Monad.State import Text.ParserCombinators.Parsec type Board = Array (Int, Int) Char data Game = Game { pos :: (Int, Int) , board :: Board , ok :: Bool } deriving Show bfs :: (a -> [b]) -> [a] -> [b] bfs f queue = foldr (?a b -> f a ++ b) [] queue trymax = 10 findloop queue (sizex, sizey) = let findloop' queue c | c <= trymax && found = c | c <= trymax = findloop' newqueue (c+1) | otherwise = -1 where found = any judge queue newqueue = bfs step queue in findloop' queue 0 where judge = ?game -> ok game step game = catMaybes [stepR,stepU,stepL,stepD] where (x,y) = pos game b = board game stepR = go $ zip [x..sizex] (repeat y) stepU = go $ zip (repeat x) [y,y-1..1] stepL = go $ zip [x,x-1..1] (repeat y) stepD = go $ zip (repeat x) [y..sizey] go :: [(Int, Int)] -> Maybe Game go [] = Nothing go (pt:pts) | ok pt && isStop = Just go' | otherwise = Nothing where go' = case b!(head pt13) of '3' -> game { ok=True } '1' -> game { board=b//[((head pt13),'0')] , pos=move (x,y) (head pt13) } pt13 = filter f pts ok (x,y) = and [x>0,y>0,x<=sizex,y<=sizey,b!(x,y)/='1'] isStop = pt13 /= [] f (x,y) = (b!(x,y)=='1')||(b!(x,y)=='3') move (fromx,fromy) (tox,toy) | fromy==toy && tox>fromx = (tox-1,toy) | fromy==toy && tox<fromx = (tox+1,toy) | fromx==tox && toy>fromy = (tox,toy-1) | fromx==tox && toy<fromy = (tox,toy+1) -- parsers -- size :: Parser (Int, Int) size = do x <- many1 digit spaces y <- many1 digit spaces return (read x, read y) input :: Parser ((Int, Int), Array (Int, Int) Char) input = do size <- size board <- many1 number eof return (size, listArray ((1,1), size) board) where number = do d <- digit spaces return d -- main -- main :: IO () main = do (filepath:_) <- getArgs src <- readFile filepath case parse input "" src of Left _ -> putStrLn "Parse Error!" Right (size, board) -> let spos = startpos board start = Game { pos = spos , board = board//[(spos,'0')] , ok = False} in print $ findloop [start] size where startpos board = fromJust $ lookup '2' (map (?(x,y)->(y,x)) $ assocs board)