日本情報オリンピック 第5回 予選 第4問目
今回も思い切り富豪化してしまった...orz
この手の問題は何かツボというか急所というかそういうのがあるのかな?
module Main (main) where import Data.List import System import Control.Monad import Control.Monad.State type Cups = [Int] data Ts = Ts Cups Cups Cups deriving (Show, Eq) move :: Ts -> [Ts] move (Ts xs ys zs) = [Ts x y zs | (x,y) <- ns] ++ [Ts xs y z | (y,z) <- ms] where ns = move' xs ys ms = move' ys zs move' :: Cups -> Cups -> [(Cups,Cups)] move' xs ys | xs == [] && ys == [] = [([],[])] | xs == [] = [([y], reverse rys)] | ys == [] = [(reverse rxs, [x])] | otherwise = case compare x y of LT -> [(xs ++ [y], reverse rys)] EQ -> [(xs ++ [y], reverse rys),(reverse rxs, ys ++ [x])] GT -> [(reverse rxs, ys ++ [x])] where (x:rxs) = reverse xs (y:rys) = reverse ys moveN :: Int -> Ts -> [Bool] moveN n ts = evalState (sequence (replicate (n + 1) moveS)) [ts] moveS :: State [Ts] Bool moveS = do tss <- get result <- return $ filter ((==) False . flip elem tss) $ nub $ concatMap move tss if or $ map match result then return True else put result >> return False execute :: Int -> Ts -> Int execute n ts | match ts = 0 | n == 0 = -1 | otherwise = count 0 $ moveN n ts match (Ts _ [] []) = True match (Ts [] [] _) = True match otherwise = False count n [] = -1 count n (x:xs) | x == True = n + 1 | otherwise = count (n + 1) xs main :: IO () main = do (inputFile:_) <- getArgs ls <- liftM lines $ readFile inputFile let limit = read $ last $ words $ head ls trays = makeTs $ map (map read . tail . words) $ tail ls result = execute limit trays writeFile "output.txt" $ show result where makeTs (x:y:z:_) = Ts x y z