src/advent04/advent04.hs

   1 {-# LANGUAGE OverloadedStrings #-}
   2
   3 import Data.List
   4 -- import Data.Tuple (swap)
   5
   6 import Data.Text (Text)
   7 import qualified Data.Text.IO as TIO
   8
   9 import Data.Void (Void)
  10
  11 import Text.Megaparsec
  12 import Text.Megaparsec.Char
  13 import qualified Text.Megaparsec.Char.Lexer as L
  14 import qualified Control.Applicative as CA
  15
  16 import Data.Time
  17 -- import Data.Time.LocalTime
  18
  19 import qualified Data.Set as S
  20 import qualified Data.Map.Strict as M
  21
  22 type GuardId = Integer
  23
  24 data LogEvent = Arrives GuardId | Sleeps | Wakes deriving (Eq, Show, Ord)
  25 data LogEntry = LogEntry { _logTime :: UTCTime , _logEvent :: LogEvent } deriving (Eq, Show, Ord)
  26
  27 data GuardState = Asleep UTCTime | Awake
  28 data LogTracker = LogTracker {_currentGuard :: GuardId, _currentState :: GuardState }
  29
  30 type GuardActivity = S.Set (UTCTime, GuardId)
  31 type Guards = S.Set GuardId
  32 -- type Minutes = S.Set Int
  33 type GuardSleepDuration = M.Map GuardId Int
  34 type SleepFrequency = M.Map Int Int -- key = minute, value = times spent asleep
  35 type GuardSleepFrequency = M.Map (GuardId, Int) Int -- key = (guardID, minute), value = times spent asleep
  36
  37
  38
  39 main :: IO ()
  40 main = do
  41         text <- TIO.readFile "data/advent04.txt"
  42         let guardLog = sort $ successfulParse text
  43         let activity = buildActivity guardLog
  44         print $ part1 activity
  45         print $ part2 activity
  46
  47 part1 :: GuardActivity -> Int
  48 part1 activity = (fromIntegral sg) * mostAsleep
  49     where sd = sleepDurations activity
  50           sg = sleepiestGuard sd
  51           sga = guardActivity sg activity
  52           sgf = sleepFrequency sga
  53           mostAsleep = keyOfMaxValue sgf
  54
  55 part2 :: GuardActivity -> Int
  56 part2 activity = (fromIntegral g) * m
  57     where gids = guardsOf activity
  58           sleepTimes = M.fromSet (\gid -> guardSleepFrequency gid activity) gids
  59           gsfs = M.foldrWithKey' rekeySleep M.empty sleepTimes
  60           (g, m) = keyOfMaxValue gsfs
  61
  62 rekeySleep :: GuardId -> SleepFrequency -> GuardSleepFrequency -> GuardSleepFrequency
  63 rekeySleep gid sleepFreq guardSleepFreq = M.foldrWithKey' (\m f gsf -> M.insert (gid, m) f gsf) guardSleepFreq sleepFreq
  64
  65
  66
  67 buildActivity :: [LogEntry] -> GuardActivity
  68 buildActivity guardLog = snd $ foldl' processLogEntry' (initialTracker, S.empty) guardLog
  69     where initialTracker = LogTracker {_currentGuard = 0, _currentState = Awake}
  70           processLogEntry' (tracker, activity) entry = processLogEntry (_logEvent entry) (_logTime entry) tracker activity
  71
  72 processLogEntry :: LogEvent -> UTCTime -> LogTracker -> GuardActivity -> (LogTracker, GuardActivity)
  73 processLogEntry (Arrives gid) _    _       activity = (LogTracker {_currentGuard = gid, _currentState = Awake}, activity)
  74 processLogEntry Sleeps        time tracker activity = (tracker {_currentState = Asleep time}, activity)
  75 processLogEntry Wakes         time tracker activity = (tracker {_currentState = Awake}, activity')
  76     where Asleep sleepTime = _currentState tracker
  77           guardId = _currentGuard tracker
  78           sleepMinutes = unfoldr unfoldF sleepTime
  79           unfoldF now = if now >= time then Nothing
  80                         else Just ((now, guardId), addUTCTime 60 now)
  81           activity' = S.union activity $ S.fromList sleepMinutes
  82
  83 guardsOf :: GuardActivity -> Guards
  84 guardsOf = S.map snd
  85
  86 -- minutesOf :: GuardActivity -> Minutes
  87 -- minutesOf activity = S.map (toMinutes . fst) activity
  88
  89 toMinutes :: UTCTime -> Int
  90 toMinutes = todMin . timeToTimeOfDay . utctDayTime
  91
  92 totalSleepDuration :: GuardId -> GuardActivity -> Int
  93 totalSleepDuration gid activity = S.size $ guardActivity gid activity
  94
  95 -- all activity of one guard
  96 guardActivity :: GuardId -> GuardActivity -> GuardActivity
  97 guardActivity gid activity = S.filter (\(_, g) -> g == gid) activity
  98
  99 sleepDurations :: GuardActivity -> GuardSleepDuration
 100 sleepDurations activity = M.fromSet guardSleepDuration gids
 101     where gids = guardsOf activity
 102           guardSleepDuration gid = totalSleepDuration gid activity
 103
 104
 105 sleepiestGuard :: GuardSleepDuration -> GuardId
 106 sleepiestGuard = keyOfMaxValue
 107
 108
 109 keyOfMaxValue :: Ord b => M.Map a b -> a
 110 keyOfMaxValue m = fst $ M.foldrWithKey mergeKV (M.findMin m) m
 111     where mergeKV k v (bestK, bestV) =
 112             if v > bestV then (k, v) else (bestK, bestV)
 113
 114
 115 sleepFrequency :: GuardActivity -> SleepFrequency
 116 sleepFrequency activity = S.foldl' updateSF M.empty activity
 117     where updateSF m (t, _) = M.insert (toMinutes t) ((M.findWithDefault 0 (toMinutes t) m) + 1) m
 118
 119 guardSleepFrequency :: GuardId -> GuardActivity -> SleepFrequency
 120 guardSleepFrequency gid activity = sleepFrequency $ guardActivity gid activity
 121
 122
 123 -- Parse the input file
 124
 125 type Parser = Parsec Void Text
 126
 127 sc :: Parser ()
 128 sc = L.space (skipSome spaceChar) CA.empty CA.empty
 129 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
 130
 131 lexeme  = L.lexeme sc
 132 integer = lexeme L.decimal
 133 symb = L.symbol sc
 134
 135 openP = symb "["
 136 closeP = symb "]"
 137 dashP = symb "-"
 138 colonP = symb ":"
 139
 140
 141 logFileP = many logEntryP
 142 logEntryP = logify <$> timeStampP <*> eventP
 143     where logify t e = LogEntry {_logTime = t, _logEvent = e}
 144
 145
 146 eventP = arrivesP <|> sleepsP <|> wakesP
 147 arrivesP = Arrives <$> ((symb "Guard #") *> integer <* (symb "begins shift"))
 148 sleepsP = Sleeps <$ (symb "falls asleep")
 149 wakesP = Wakes <$ (symb "wakes up")
 150
 151 -- [1518-10-25 00:48]
 152 timeStampP = between openP closeP timeStampInnerP
 153 timeStampInnerP = dtify <$> integer <* dashP <*> integer <* dashP <*> integer <*> integer <* colonP <*> integer
 154     where dtify y mo d h mi = UTCTime (fromGregorian y (fromIntegral mo) (fromIntegral d)) (tify h mi)
 155           tify h mi = secondsToDiffTime ((h * 60) + mi) * 60
 156
 157 successfulParse :: Text -> [LogEntry]
 158 successfulParse input =
 159         case parse logFileP "input" input of
 160                 Left  _error -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
 161                 Right guardLog -> guardLog