X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent02%2FMainApplicative.hs;fp=advent02%2FMainApplicative.hs;h=14cb248db042a1fb0a851608c4e7fbc5e7a71f70;hb=6bab7cfb5555d7c4148c951ffb2454849bce6ac0;hp=0000000000000000000000000000000000000000;hpb=144c9843945d8af62fc35f96b5063283a52055d8;p=advent-of-code-23.git

diff --git a/advent02/MainApplicative.hs b/advent02/MainApplicative.hs
new file mode 100644
index 0000000..14cb248
--- /dev/null
+++ b/advent02/MainApplicative.hs
@@ -0,0 +1,104 @@
+-- Writeup at https://work.njae.me.uk/2023/12/02/advent-of-code-2023-day-02/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (Result)
+import Control.Applicative
+import Data.Monoid
+import Data.Semigroup
+import Data.Foldable
+-- import Control.Applicative (Applicative(liftA2))
+
+
+data Game = Game {getID :: Int, getRevelations :: [Revelation Int]} 
+  deriving (Show)
+data Revelation a = Revelation a a a 
+  deriving (Show, Functor, Foldable)
+
+instance Applicative Revelation where
+  pure n = Revelation n n n
+  (Revelation rf gf bf) <*> (Revelation r g b) = 
+    Revelation (rf r) (gf g) (bf b)
+
+instance (Semigroup a) => Semigroup (Revelation a) where
+  rev1 <> rev2 = liftA2 (<>) rev1 rev2
+
+instance (Monoid a) => Monoid (Revelation a) where
+  mempty = Revelation mempty mempty mempty
+
+data ParsedGame = ParsedGame Int [Showings] deriving (Show)
+type Showings = [Cube]
+data Cube = Cube Colour Int deriving (Show)
+data Colour = Red | Green | Blue deriving (Show)
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let parsedGames = successfulParse text
+      -- print parsedGames
+      let games = fmap engame parsedGames
+      -- print games
+      print $ part1 games
+      print $ part2 games
+
+
+part1, part2 :: [Game] -> Int
+part1 = sum . fmap getID . filter (possible limit)
+  where limit = Revelation 12 13 14
+
+part2 = sum . fmap (power . required)
+
+possible :: Revelation Int -> Game -> Bool
+-- possible limit = all id . liftA2 (>=) limit . required
+possible limit = getAll . fold . fmap All . liftA2 (>=) limit . required
+
+required :: Game -> Revelation Int
+required = fmap getMax . mconcat . fmap (fmap Max) . getRevelations
+
+power :: Revelation Int -> Int
+power = getProduct . fold . fmap Product
+
+
+-- conversion from parsed to real data
+
+engame :: ParsedGame -> Game
+engame (ParsedGame n showings) = Game n (fmap revealify showings)
+
+revealify :: Showings -> Revelation Int
+revealify = fmap getSum . mconcat . fmap (fmap Sum) . fmap reveal
+
+reveal :: Cube -> Revelation Int
+reveal (Cube Red   n) = Revelation n 0 0
+reveal (Cube Green n) = Revelation 0 n 0
+reveal (Cube Blue  n) = Revelation 0 0 n
+
+
+-- Parse the input file
+
+gamesP :: Parser [ParsedGame]
+gameP :: Parser ParsedGame
+showingsP :: Parser [Showings]
+showingP :: Parser Showings
+cubeP :: Parser Cube
+colourP, redP, greenP, blueP :: Parser Colour
+
+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"
+
+
+successfulParse :: Text -> [ParsedGame]
+successfulParse input = 
+  case parseOnly gamesP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right matches -> matches