Day 2 was a day where a declarative approach to the problem paid off. Just writing down some definitions led to a neat solution.
Part 1
I started by writing down some things I know. A Game
has an ID and a set of Revelation
s. A Revelation
is a group of red, green, and blue reveals.
data Game = Game {getID :: Int, getRevelations :: [Revelation]}
deriving (Eq, Show)
data Revelation = Revelation Int Int Int deriving (Eq, Show)
A Revelation
is compatibleWith
a limit if all of the red, green, blue shown are less than the corresponding quantities in the limit. (This is the same as defining a partial order on revelations, but I don't need all of that here.) A game is possible
(given a limit) if all
its revelations are compatibleWith
that limit.
compatibleWith :: Revelation -> Revelation -> Bool
compatibleWith (Revelation r0 g0 b0) (Revelation r1 g1 b1) =
(r0 <= r1) && (g0 <= g1) && (b0 <= b1)
possible :: Game -> Revelation -> Bool
possible game limit =
all (`compatibleWith` limit) $ getRevelations game
I can solve Part 1 by filter
ing the games that are possible, extracting the IDs, and adding them.
part1 :: [Game] -> Int
part1 games = sum $ fmap getID $ filter (`possible` limit) games
where limit = Revelation 12 13 14
Part 2
This is all about combining revelations to find the minimum bounds on a game. Combining objects is what monoids are all about.
The bounds implied by two revelations are the maximums of each element. The bounds of no revelations is zero of each element.
instance Semigroup Revelation where
(Revelation r0 g0 b0) <> (Revelation r1 g1 b1) =
Revelation (max r0 r1) (max g0 g1) (max b0 b1)
instance Monoid Revelation where
mempty = Revelation 0 0 0
That gives me mconcat
for free, and the bounds of a game is the combination of all the revelations.
required :: Game -> Revelation
required = mconcat . getRevelations
To solve part 2, I find the power of the requirements of each game, then add them up.
power :: Revelation -> Int
power (Revelation r g b) = r * g * b
part2 :: [Game] -> Int
part2 = sum . fmap (power . required)
Parsing
All the above needs Game
s and Revelation
s, which isn't what's in the input file. I decided to take a two-stage approach to handling the input.
- Parse the input into a structure that follows that of the input.
- Convert that structure into the one of
Game
andRevelation
.
I could do it all in one, but I think this approach is easier to test and debug, keeps the code easier to debug, and allows for dual-use of the input if part 2 ended up doing something very different with the same input (as 2022 day 2 did).
Reading the input
I need new data structures to hold the results of parsing, so I define a ParsedGame
, a Showing
, a Cube
, and the Colour
s.
data ParsedGame = ParsedGame Int [Showings] deriving (Eq, Show)
type Showings = [Cube]
data Cube = Cube Colour Int deriving (Eq, Show)
data Colour = Red | Green | Blue deriving (Eq, Show)
Parsing pretty much follows the pattern of the input file, using attoparsec. The only interesting part is the use of flip
in cubeP
to change the order of arguments.
gamesP = gameP `sepBy` endOfLine
gameP = ParsedGame <$> (("Game " *> decimal) <* ": ") <*> showingsP
showingsP = showingP `sepBy` "; "
showingP = cubeP `sepBy` ", "
cubeP = (flip Cube) <$> (decimal <* " ") <*> colourP
colourP = redP <|> greenP <|> blueP
redP = Red <$ "red"
greenP = Green <$ "green"
blueP = Blue <$ "blue"
Converting the parsed data
My overall approach here is to convert each Cube
into a Revelation
of only one colour, then merge those Revelation
s into the actual Revelation
of this round of the Game
.
Merging revelations again implies a monoid, but now I want to use a different combining operation. The idiomatic way to do that is to wrap the Revelation
in a newtype
and define my merging monoid on that newtype
.
newtype Merging = Merging { getMerging :: Revelation } deriving (Eq, Show)
instance Semigroup Merging where
(Merging (Revelation r0 g0 b0)) <> (Merging (Revelation r1 g1 b1)) =
Merging (Revelation (r0 + r1) (g0 + g1) (b0 + b1))
instance Monoid Merging where
mempty = Merging (Revelation 0 0 0)
Revealing one Cube
produces a Merging (Revelation ...)
, which I can merge with mconcat
and extract the Revelation
with getMerging
.
engame :: ParsedGame -> Game
engame (ParsedGame n showings) = Game n (fmap revealify showings)
revealify :: Showings -> Revelation
revealify = getMerging . mconcat . (fmap reveal)
reveal :: Cube -> Merging
reveal (Cube Red n) = Merging (Revelation n 0 0)
reveal (Cube Green n) = Merging (Revelation 0 n 0)
reveal (Cube Blue n) = Merging (Revelation 0 0 n)
Code
You can get the code from my locally-hosted Git repo, or from Gitlab.