Day 23 part 2
[advent-of-code-23.git] / advent02 / MainApplicative.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 import Data.Monoid
9 import Data.Semigroup
10 import Data.Foldable
11 -- import Control.Applicative (Applicative(liftA2))
12
13
14 data Game = Game {getID :: Int, getRevelations :: [Revelation Int]}
15 deriving (Show)
16 data Revelation a = Revelation a a a
17 deriving (Show, Functor, Foldable)
18
19 instance Applicative Revelation where
20 pure n = Revelation n n n
21 (Revelation rf gf bf) <*> (Revelation r g b) =
22 Revelation (rf r) (gf g) (bf b)
23
24 instance (Semigroup a) => Semigroup (Revelation a) where
25 rev1 <> rev2 = liftA2 (<>) rev1 rev2
26
27 instance (Monoid a) => Monoid (Revelation a) where
28 mempty = Revelation mempty mempty mempty
29
30 data ParsedGame = ParsedGame Int [Showings] deriving (Show)
31 type Showings = [Cube]
32 data Cube = Cube Colour Int deriving (Show)
33 data Colour = Red | Green | Blue deriving (Show)
34
35 main :: IO ()
36 main =
37 do dataFileName <- getDataFileName
38 text <- TIO.readFile dataFileName
39 let parsedGames = successfulParse text
40 -- print parsedGames
41 let games = fmap engame parsedGames
42 -- print games
43 print $ part1 games
44 print $ part2 games
45
46
47 part1, part2 :: [Game] -> Int
48 part1 = sum . fmap getID . filter (possible limit)
49 where limit = Revelation 12 13 14
50
51 part2 = sum . fmap (power . required)
52
53 possible :: Revelation Int -> Game -> Bool
54 -- possible limit = all id . liftA2 (>=) limit . required
55 possible limit = getAll . fold . fmap All . liftA2 (>=) limit . required
56
57 required :: Game -> Revelation Int
58 required = fmap getMax . mconcat . fmap (fmap Max) . getRevelations
59
60 power :: Revelation Int -> Int
61 power = getProduct . fold . fmap Product
62
63
64 -- conversion from parsed to real data
65
66 engame :: ParsedGame -> Game
67 engame (ParsedGame n showings) = Game n (fmap revealify showings)
68
69 revealify :: Showings -> Revelation Int
70 revealify = fmap getSum . mconcat . fmap (fmap Sum) . fmap reveal
71
72 reveal :: Cube -> Revelation Int
73 reveal (Cube Red n) = Revelation n 0 0
74 reveal (Cube Green n) = Revelation 0 n 0
75 reveal (Cube Blue n) = Revelation 0 0 n
76
77
78 -- Parse the input file
79
80 gamesP :: Parser [ParsedGame]
81 gameP :: Parser ParsedGame
82 showingsP :: Parser [Showings]
83 showingP :: Parser Showings
84 cubeP :: Parser Cube
85 colourP, redP, greenP, blueP :: Parser Colour
86
87 gamesP = gameP `sepBy` endOfLine
88 gameP = ParsedGame <$> (("Game " *> decimal) <* ": ") <*> showingsP
89
90 showingsP = showingP `sepBy` "; "
91 showingP = cubeP `sepBy` ", "
92 cubeP = (flip Cube) <$> (decimal <* " ") <*> colourP
93
94 colourP = redP <|> greenP <|> blueP
95 redP = Red <$ "red"
96 greenP = Green <$ "green"
97 blueP = Blue <$ "blue"
98
99
100 successfulParse :: Text -> [ParsedGame]
101 successfulParse input =
102 case parseOnly gamesP input of
103 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
104 Right matches -> matches