X-Git-Url: https://git.njae.me.uk/?a=blobdiff_plain;f=advent02%2FMain.hs;fp=advent02%2FMain.hs;h=d33a26b47d23148a156f349075f7e57fccfbbf83;hb=af2928ada523abf40d427402ba93d11b326d013c;hp=0000000000000000000000000000000000000000;hpb=68967ae847636a1892aecf66a77fc5474f296eff;p=advent-of-code-23.git

diff --git a/advent02/Main.hs b/advent02/Main.hs
new file mode 100644
index 0000000..d33a26b
--- /dev/null
+++ b/advent02/Main.hs
@@ -0,0 +1,110 @@
+-- Writeup at https://work.njae.me.uk/2022/12/02/advent-of-code-2022-day-2/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (Result)
+import Control.Applicative
+
+
+data Game = Game {getID :: Int, getRevelations :: [Revelation]} 
+  deriving (Eq, Show)
+data Revelation = Revelation Int Int Int deriving (Eq, Show)
+
+instance Semigroup Revelation where
+  (Revelation r0 g0 b0) <> (Revelation r1 g1 b1) = 
+    Revelation (max r0 r1) (max g0 g1) (max b0 b1)
+
+instance Monoid Revelation where
+  mempty = Revelation 0 0 0
+
+
+newtype Merging = Merging { getMerging :: Revelation } deriving (Eq, Show)
+
+instance Semigroup Merging where
+  (Merging (Revelation r0 g0 b0)) <> (Merging (Revelation r1 g1 b1)) = 
+    Merging (Revelation (r0 + r1) (g0 + g1) (b0 + b1))
+
+instance Monoid Merging where
+  mempty = Merging (Revelation 0 0 0)
+
+data ParsedGame = ParsedGame Int [Showings] deriving (Eq, Show)
+type Showings = [Cube]
+data Cube = Cube Colour Int deriving (Eq, Show)
+data Colour = Red | Green | Blue deriving (Eq, 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 games = sum $ fmap getID $ filter (`possible` limit) games
+  where limit = Revelation 12 13 14
+
+part2 = sum . fmap (power . required)
+
+
+compatibleWith :: Revelation -> Revelation -> Bool
+compatibleWith (Revelation r0 g0 b0) (Revelation r1 g1 b1) = 
+  (r0 <= r1) && (g0 <= g1) && (b0 <= b1)
+
+possible :: Game -> Revelation -> Bool
+possible game limit = 
+  all (`compatibleWith` limit) $ getRevelations game
+
+required :: Game -> Revelation
+required = mconcat . getRevelations
+
+power :: Revelation -> Int
+power (Revelation r g b) = r * g * b
+
+
+-- conversion from parsed to real data
+
+engame :: ParsedGame -> Game
+engame (ParsedGame n showings) = Game n (fmap revealify showings)
+
+revealify :: Showings -> Revelation
+revealify = getMerging . mconcat . (fmap reveal)
+
+reveal :: Cube -> Merging
+reveal (Cube Red   n) = Merging (Revelation n 0 0)
+reveal (Cube Green n) = Merging (Revelation 0 n 0)
+reveal (Cube Blue  n) = Merging (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