オフラインリアルタイムどう書く第四回の参考問題 解答 (Haskell版)

http://qiita.com/items/9c514267214d3917edf2 の解答をHaskellで書いてみた。

Listモナドの挙動をちゃんと理解してなくて、guard周りでハマって時間を食ってしまった。
後、通行止め経路の持ち回りがダサい。

多分、ちゃんと解くのに3時間ぐらいかかったと思う。
計算効率をあんまり考えてないので、多分マス目増えると破綻するw

今回、練習も兼ねてdoctestでTDD的にやってみた。
これはこれで結構いいかも知れないが、
showの出力をちゃんと考えておかないと、期待値の記述が超めんどくなる罠があった。

cabalの記述も含めたGithubは以下。
https://github.com/joker1007/offline-doukaku4-sample

module Main where

import Data.Set
import Data.Char
import Control.Monad
import System.Environment
import Control.Applicative ((<$>))

-- | U V W X Y
-- | P Q R S T
-- | K L M N O
-- | F G H I J
-- | A B C D E
data Node = A | B | C | D | E | F | G | H | I | J | K | L | M | N | O | P | Q | R | S | T | U | V | W | X | Y deriving (Show, Eq, Ord, Enum, Read)

data Path = Path {pathSource :: Node, pathTarget :: Node} deriving (Eq)

instance Show Path where
    show a = show (pathSource a) ++ "-" ++ show (pathTarget a)

data Vertex = Vertex {vertexNode :: Node, getPaths :: [Path]}

instance Ord Vertex where
    compare a b = vertexNode a `compare` vertexNode b

instance Show Vertex where
    show a = "(" ++ show (vertexNode a) ++ "," ++ show (getPaths a) ++ ")"

instance Eq Vertex where
    (==) a b = vertexNode a == vertexNode b

data Step = Step { currentVertex :: Vertex, getSteps :: [Vertex], visitted :: Set Vertex }

instance Show Step where
    show a = show $ Prelude.map vertexNode $ getSteps a

-- |
-- >>> parsePath "af"
-- [A-F]
--
-- >>> parsePath "af kl"
-- [A-F,K-L]
parsePath :: String -> [Path]
parsePath ss = Prelude.map p $ words ss
  where
    p (s:t:[]) = Path (read [toUpper s]) (read [toUpper t])
    p _ = error "should not be here"

-- |
-- >>> createVertex A []
-- (A,[A-B,A-F])
--
-- >>> createVertex A [Path A F]
-- (A,[A-B])
--
-- >>> createVertex B []
-- (B,[B-A,B-C,B-G])
--
-- >>> createVertex X [Path X Y, Path S X]
-- (X,[X-W])
createVertex :: Node -> [Path] -> Vertex
createVertex n ps = Vertex n paths
  where
    paths = Prelude.map (Path n) $ snd table
    succ5 :: (Enum a) => a -> a
    succ5 = succ . succ . succ . succ . succ

    pred5 :: (Enum a) => a -> a
    pred5 = pred . pred . pred . pred . pred

    table
      | n == A = (n, filterTable [succ n, succ5 n])
      | n == E = (n, filterTable [pred n, succ5 n])
      | n == U = (n, filterTable [pred5 n, succ n])
      | n == Y = (n, filterTable [pred5 n, pred n])
      | n `elem` [B,C,D] = (n, filterTable [pred n, succ n, succ5 n])
      | n `elem` [G,H,I,L,M,N,Q,R,S] = (n, filterTable [pred5 n, pred n, succ n, succ5 n])
      | n `elem` [F,K,P] = (n, filterTable [pred5 n, succ n, succ5 n])
      | n `elem` [J,O,T] = (n, filterTable [pred5 n, pred n, succ5 n])
      | n `elem` [V,W,X] = (n, filterTable [pred5 n, pred n, succ n])
      | otherwise = error "should not here"
    filterTable = Prelude.filter (\n2 -> notElem (Path n2 n) ps && notElem (Path n n2) ps)

-- |
-- >>> let s = initStep []
-- >>> length $ nextStep [] s
-- 8512
nextStep :: [Path] -> Step -> [()]
nextStep ps s = do p <- getPaths $ currentVertex s
                   let v = createVertex (pathTarget p) ps
                   guard $ Data.Set.notMember v $ visitted s
                   let ns = Step v (v:getSteps s) (Data.Set.insert v $ visitted s)
                   unless (vertexNode v == Y) $ nextStep ps ns

initStep :: [Path] -> Step
initStep ps = let a = createVertex A ps
              in Step a [a] $ Data.Set.fromList [a]

main :: IO ()
main = do stopPaths <- parsePath <$> liftM head getArgs
          let s = nextStep stopPaths $ initStep stopPaths
          print $ length s