Using Applicatives in day 2

diff --git a/advent-of-code23.cabal b/advent-of-code23.cabal
index 7f89b118e77728afe116ad3b99f405df08c3e964..e7c24ee6f2e8f4afc4defdc4046a2aea51ae53a3 100644 (file)
--- a/advent-of-code23.cabal
+++ b/advent-of-code23.cabal
@@ -106,6 +106,11 @@ executable advent02
   main-is: advent02/Main.hs
   build-depends: text, attoparsec
 
+executable advent02a
+  import: common-extensions, build-directives
+  main-is: advent02/MainApplicative.hs
+  build-depends: text, attoparsec
+
 executable advent03
   import: common-extensions, build-directives
   main-is: advent03/Main.hs

diff --git a/advent02/MainApplicative.hs b/advent02/MainApplicative.hs
new file mode 100644 (file)
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