Done day 9
[advent-of-code-23.git] / advent02 / Main.hs
1 -- Writeup at https://work.njae.me.uk/2023/12/02/advent-of-code-2023-day-02/
2
3 import AoC
4 import Data.Text (Text)
5 import qualified Data.Text.IO as TIO
6 import Data.Attoparsec.Text hiding (Result)
7 import Control.Applicative
8
9
10 data Game = Game {getID :: Int, getRevelations :: [Revelation]}
11 deriving (Eq, Show)
12 data Revelation = Revelation Int Int Int deriving (Eq, Show)
13
14 instance Semigroup Revelation where
15 (Revelation r0 g0 b0) <> (Revelation r1 g1 b1) =
16 Revelation (max r0 r1) (max g0 g1) (max b0 b1)
17
18 instance Monoid Revelation where
19 mempty = Revelation 0 0 0
20
21
22 newtype Merging = Merging { getMerging :: Revelation } deriving (Eq, Show)
23
24 instance Semigroup Merging where
25 (Merging (Revelation r0 g0 b0)) <> (Merging (Revelation r1 g1 b1)) =
26 Merging (Revelation (r0 + r1) (g0 + g1) (b0 + b1))
27
28 instance Monoid Merging where
29 mempty = Merging (Revelation 0 0 0)
30
31 data ParsedGame = ParsedGame Int [Showings] deriving (Eq, Show)
32 type Showings = [Cube]
33 data Cube = Cube Colour Int deriving (Eq, Show)
34 data Colour = Red | Green | Blue deriving (Eq, Show)
35
36 main :: IO ()
37 main =
38 do dataFileName <- getDataFileName
39 text <- TIO.readFile dataFileName
40 let parsedGames = successfulParse text
41 -- print parsedGames
42 let games = fmap engame parsedGames
43 -- print games
44 print $ part1 games
45 print $ part2 games
46
47
48 part1, part2 :: [Game] -> Int
49 part1 games = sum $ fmap getID $ filter (`possible` limit) games
50 where limit = Revelation 12 13 14
51
52 part2 = sum . fmap (power . required)
53
54
55 compatibleWith :: Revelation -> Revelation -> Bool
56 compatibleWith (Revelation r0 g0 b0) (Revelation r1 g1 b1) =
57 (r0 <= r1) && (g0 <= g1) && (b0 <= b1)
58
59 possible :: Game -> Revelation -> Bool
60 possible game limit =
61 all (`compatibleWith` limit) $ getRevelations game
62
63 required :: Game -> Revelation
64 required = mconcat . getRevelations
65
66 power :: Revelation -> Int
67 power (Revelation r g b) = r * g * b
68
69
70 -- conversion from parsed to real data
71
72 engame :: ParsedGame -> Game
73 engame (ParsedGame n showings) = Game n (fmap revealify showings)
74
75 revealify :: Showings -> Revelation
76 revealify = getMerging . mconcat . (fmap reveal)
77
78 reveal :: Cube -> Merging
79 reveal (Cube Red n) = Merging (Revelation n 0 0)
80 reveal (Cube Green n) = Merging (Revelation 0 n 0)
81 reveal (Cube Blue n) = Merging (Revelation 0 0 n)
82
83
84 -- Parse the input file
85
86 gamesP :: Parser [ParsedGame]
87 gameP :: Parser ParsedGame
88 showingsP :: Parser [Showings]
89 showingP :: Parser Showings
90 cubeP :: Parser Cube
91 colourP, redP, greenP, blueP :: Parser Colour
92
93 gamesP = gameP `sepBy` endOfLine
94 gameP = ParsedGame <$> (("Game " *> decimal) <* ": ") <*> showingsP
95
96 showingsP = showingP `sepBy` "; "
97 showingP = cubeP `sepBy` ", "
98 cubeP = (flip Cube) <$> (decimal <* " ") <*> colourP
99
100 colourP = redP <|> greenP <|> blueP
101 redP = Red <$ "red"
102 greenP = Green <$ "green"
103 blueP = Blue <$ "blue"
104
105
106 successfulParse :: Text -> [ParsedGame]
107 successfulParse input =
108 case parseOnly gamesP input of
109 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
110 Right matches -> matches