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