Done day 13

[advent-of-code-22.git] / advent13 / Main.hs

diff --git a/advent13/Main.hs b/advent13/Main.hs
new file mode 100644 (file)
index 0000000..a13226c
--- /dev/null
+++ b/advent13/Main.hs
@@ -0,0 +1,61 @@
+-- Writeup at https://work.njae.me.uk/2022/12/15/advent-of-code-2022-day-13/
+
+import AoC
+import Data.Text (Text)
+import qualified Data.Text.IO as TIO
+import Data.Attoparsec.Text hiding (take)
+import Control.Applicative
+import Data.List
+
+data Packet = List [Packet] | Element Int
+  deriving (Eq)
+
+instance Show Packet where
+  show (Element n) = show n
+  show (List ns) = "[" ++ (intercalate "," $ map show ns) ++ "]"
+
+instance Ord Packet where
+  (Element a)   `compare` (Element b)  = a `compare` b
+  (Element a)   `compare` (List bs)    = (List [Element a]) `compare` (List bs)
+  (List as)     `compare` (Element b)  = (List as) `compare` (List [Element b])
+  (List [])     `compare` (List [])    = EQ
+  (List [])     `compare` (List (_:_)) = LT
+  (List (_:_))  `compare` (List [])    = GT
+  (List (a:as)) `compare` (List (b:bs)) 
+    | a `compare` b == EQ = (List as) `compare` (List bs)
+    | otherwise = a `compare` b
+
+main :: IO ()
+main = 
+  do  dataFileName <- getDataFileName
+      text <- TIO.readFile dataFileName
+      let pairs = successfulParse text
+      print $ part1 pairs
+      print $ part2 pairs
+
+part1, part2 :: [(Packet, Packet)] -> Int
+part1  = sum . fmap (1 +) . elemIndices True . fmap (uncurry (<))
+
+part2 pairs = product dividerLocations
+  where dividers = [ List [List [Element 2]] , List [List [Element 6]] ]
+        packets = dividers ++ concatMap (\(a, b) -> [a, b]) pairs
+        dividerLocations = fmap (1 +) $ findIndices (`elem` dividers) $ sort packets
+
+-- Parse the input file
+
+pairsP :: Parser [(Packet, Packet)]
+pairP :: Parser (Packet, Packet)
+packetP, elementP, listP :: Parser Packet
+
+pairsP = pairP `sepBy` (endOfLine <* endOfLine)
+pairP = (,) <$> (packetP <* endOfLine) <*> packetP
+
+packetP = listP <|> elementP
+elementP = Element <$> decimal
+listP = List <$> ("[" *> (packetP `sepBy` ",")) <* "]"
+
+successfulParse :: Text -> [(Packet, Packet)]
+successfulParse input = 
+  case parseOnly pairsP input of
+    Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
+    Right pairs -> pairs