This repository has been archived by the owner on Nov 17, 2024. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 4
/
Copy pathDay04.hs
118 lines (105 loc) · 3.93 KB
/
Day04.hs
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
-- |
-- Module : AOC.Challenge.Day04
-- Copyright : (c) Justin Le 2018
-- License : BSD3
--
-- Maintainer : justin@jle.im
-- Stability : experimental
-- Portability : non-portable
--
-- Day 4. See "AOC.Solver" for the types used in this module!
module AOC.Challenge.Day04 (
day04a
, day04b
) where
import AOC.Common (maximumVal, maximumValBy, clearOut, freqs)
import AOC.Solver ((:~>)(..))
import AOC.Util (eitherToMaybe)
import Control.Applicative (many)
import Data.Char (isAlphaNum)
import Data.Finite (Finite, packFinite)
import Data.Map (Map)
import Data.Ord (comparing)
import Text.Read (readMaybe)
import qualified Data.Map as M
import qualified Text.Parsec as P
type Minute = Finite 60
-- | Map of minutes to times slept at that minute
type TimeCard = Map Minute Int
-- | Rudimentary time tuple
data Time = T { _tYear :: Integer
, _tMonth :: Integer
, _tDay :: Integer
, _tHour :: Finite 24
, _tMinute :: Minute
}
deriving (Show, Eq, Ord)
-- | A guard ID. It's a newtype to prevent us from accidentally mixing up
-- all of the integer types involved.
newtype Guard = G { _gId :: Int }
deriving (Show, Eq, Ord)
-- | A logged action
data Action = AShift Guard
| ASleep
| AWake
deriving (Show, Eq, Ord)
-- | Parse a stream of @('Time', 'Action')@ events
type Parser = P.Parsec [(Time, Action)] ()
-- | From a stream of @('Time', 'Action')@ events, accumulate a map of
-- guards to time cards.
buildTimeCards :: Map Time Action -> Maybe (Map Guard TimeCard)
buildTimeCards = eitherToMaybe . P.parse fullLog "" . M.toList
where
-- | A log is many guard shifts. The result is a frequency map of all
-- of the guards' accumulated minutes.
fullLog :: Parser (Map Guard TimeCard)
fullLog = fmap freqs . M.fromListWith (++) <$> many guardShift
-- | A shift is a guard chagen with many naps. Returns the minues
-- slept, with the guard ID.
guardShift :: Parser (Guard, [Minute])
guardShift = do
(_, AShift g) <- P.anyToken
napMinutes <- concat <$> many (P.try nap)
pure (g, napMinutes)
-- | A nap is a sleep then a wake. Return the minutes slept.
nap :: Parser [Minute]
nap = do
(T _ _ _ _ m0, ASleep) <- P.anyToken
(T _ _ _ _ m1, AWake ) <- P.anyToken
pure [m0 .. m1 - 1]
day04a :: Map Time Action :~> Int
day04a = MkSol
{ sParse = fmap M.fromList . traverse parseLine . lines
, sShow = show
, sSolve = \logs -> do
timeCards <- buildTimeCards logs
(worstGuard , timeCard) <- maximumValBy (comparing sum) timeCards
(worstMinute, _ ) <- maximumVal timeCard
pure $ _gId worstGuard * fromIntegral worstMinute
}
day04b :: Map Time Action :~> Int
day04b = MkSol
{ sParse = fmap M.fromList . traverse parseLine . lines
, sShow = show
, sSolve = \logs -> do
timeCards <- buildTimeCards logs
let worstMinutes :: Map Guard (Minute, Int)
worstMinutes = M.mapMaybe maximumVal timeCards
(worstGuard, (worstMinute, _)) <- maximumValBy (comparing snd) worstMinutes
pure $ _gId worstGuard * fromIntegral worstMinute
}
parseLine :: String -> Maybe (Time, Action)
parseLine str = do
[y,mo,d,h,mi] <- traverse readMaybe timeStamp
t <- T y mo d <$> packFinite h <*> packFinite mi
a <- case rest of
"falls":"asleep":_ -> Just ASleep
"wakes":"up":_ -> Just AWake
"Guard":n:_ -> AShift . G <$> readMaybe n
_ -> Nothing
pure (t, a)
where
(timeStamp, rest) = splitAt 5
. words
. clearOut (not . isAlphaNum)
$ str