src/advent04/advent04.hs

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