Submission #297334

---

Source Code Expand

import Control.Applicative
import Control.Monad
import Data.List
import qualified Data.IntMap as M
import Text.Printf


type HHMM = Int
type Minute = Int
type Count = Int


type MinuteCountMap = M.IntMap Count
type Period = (Minute, Minute)


readPeriod :: String -> Period
readPeriod s = ((toMinute . read . take 4) s, (toMinute . read . drop 5) s)


showPeriod :: Period -> String
showPeriod (st, en) = printf "%04d-%04d" (toHHMM st) (toHHMM en)


toMinute :: HHMM -> Minute
toMinute x = (h * 60) + m
  where
    h = x `div` 100
    m = x - (h * 100)

toHHMM :: Minute -> HHMM
toHHMM x = (h * 100) + m
  where
    h = x `div` 60
    m = x - (h * 60)


main :: IO ()
main = do
    num <- getNumber
    ps <- getPeriods num
    let ps' = merge $ roundPeriod <$> ps
    mapM_ putStrLn (Prelude.map showPeriod ps')


getNumber :: IO Int
getNumber = read <$> getLine


getPeriods :: Int -> IO [Period]
getPeriods num = do
    replicateM num (readPeriod <$> getLine)


roundPeriod :: Period -> Period
roundPeriod (st, en) = ((st `div` 5) * 5, ((en + 4) `div` 5) * 5)


merge :: [Period] -> [Period]
merge ps = ps'
  where
    cm = foldl' addPeriodToCountMap M.empty ps
    (ps', _, _) = M.foldlWithKey' cumsum ([], 0, 0) cm


addPeriodToCountMap :: MinuteCountMap -> Period -> MinuteCountMap
addPeriodToCountMap m (st, en) = addToCountMap en (-1) (addToCountMap st 1 m)


addToCountMap :: Minute -> Count -> MinuteCountMap -> MinuteCountMap
addToCountMap mi c m = case M.lookup mi m of
    Nothing -> M.insert mi c m
    Just c' -> case c' + c of
                0 -> M.delete mi m
                _ -> M.insert mi (c' + c) m


cumsum :: ([Period], Count, Minute) -> Minute -> Count -> ([Period], Count, Minute)
cumsum (ps, ac, st) mi c = case ac + c of
    0 -> (ps ++ [(st, mi)], 0, 0)
    _ -> case st of
        0 -> (ps, ac + c, mi)
        _ -> (ps, ac + c, st)

Submission Info

Judge Result