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