Google Code Jam/Train Timetable

import Data.List data City = A | B deriving (Eq,Ord,Show) type Time = Int -- | A point in time and space data TP = TP {at :: Time , pos :: City} deriving (Ord,Eq) data Tratta = Tratta { from :: TP, to :: TP} deriving (Ord,Eq) -- | the name of the city the train started at beginning and the TP it will be ready next data Train = Train {started :: City , doing ::TP} deriving Eq -- | test for a Train if it can do a Tratta ready :: Tratta -> Train -> Bool ready (Tratta from _) (Train _ doing) = pos from == pos doing && at doing <= at from -- | update a list of Train , a new train is added if no other can be used busy :: [Train] -> Tratta -> [Train] busy ts x = case find (ready x) ts of Nothing -> Train (pos . from $ x) (to x) : ts Just t -> Train (started t) (to x) : delete t ts -- | creates the trains from a list of Tratta to be done trains :: [Tratta] -> [Train] trains = foldl' busy [] type Versus = (City,City) parseTratta :: Int -> Versus -> String -> Tratta parseTratta ta (a,b) x = let [t1,t2] = map toMinute . words $ x toMinute (h1:h2:':':m1:[m2]) = read [h1,h2] * 60 + read [m1,m2] in Tratta (TP t1 a) (TP (t2 + ta) b) parseCase [] = Nothing parseCase (ta:m:xs) = let [t1,t2] = map read . words $ m (das,xs') = splitAt t1 xs (dbs,xs'') = splitAt t2 xs' pta = parseTratta (read ta) in Just (sort $ map (pta (A,B)) das ++ map (pta (B,A)) dbs,xs'') parseCases :: String -> [[Tratta]] parseCases x = let (n:ts) = lines x in take (read n) . unfoldr parseCase $ ts main = do ts <- parseCases `fmap` getContents flip mapM_ (zip [1..] ts) $ \(i,ns) -> do putStr $ "Case #" ++ show i ++ ": " let (as,bs) = partition ((==A). started) $ trains ns putStrLn $ (show (length as) ++ " " ++ show (length bs))