advent13/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2022/12/15/advent-of-code-2022-day-13/
   2
   3 import AoC
   4 import Data.Text (Text)
   5 import qualified Data.Text.IO as TIO
   6 import Data.Attoparsec.Text hiding (take)
   7 import Control.Applicative
   8 import Data.List
   9
  10 data Packet = List [Packet] | Element Int
  11   deriving (Eq)
  12
  13 instance Show Packet where
  14   show (Element n) = show n
  15   show (List ns) = "[" ++ (intercalate "," $ map show ns) ++ "]"
  16
  17 instance Ord Packet where
  18   (Element a)   `compare` (Element b)  = a `compare` b
  19   (Element a)   `compare` (List bs)    = (List [Element a]) `compare` (List bs)
  20   (List as)     `compare` (Element b)  = (List as) `compare` (List [Element b])
  21   (List [])     `compare` (List [])    = EQ
  22   (List [])     `compare` (List (_:_)) = LT
  23   (List (_:_))  `compare` (List [])    = GT
  24   (List (a:as)) `compare` (List (b:bs))
  25     | a `compare` b == EQ = (List as) `compare` (List bs)
  26     | otherwise = a `compare` b
  27
  28 main :: IO ()
  29 main =
  30   do  dataFileName <- getDataFileName
  31       text <- TIO.readFile dataFileName
  32       let pairs = successfulParse text
  33       print $ part1 pairs
  34       print $ part2 pairs
  35
  36 part1, part2 :: [(Packet, Packet)] -> Int
  37 part1  = sum . fmap (1 +) . elemIndices True . fmap (uncurry (<))
  38
  39 part2 pairs = product dividerLocations
  40   where dividers = [ List [List [Element 2]] , List [List [Element 6]] ]
  41         packets = dividers ++ concatMap (\(a, b) -> [a, b]) pairs
  42         dividerLocations = fmap (1 +) $ findIndices (`elem` dividers) $ sort packets
  43
  44 -- Parse the input file
  45
  46 pairsP :: Parser [(Packet, Packet)]
  47 pairP :: Parser (Packet, Packet)
  48 packetP, elementP, listP :: Parser Packet
  49
  50 pairsP = pairP `sepBy` (endOfLine <* endOfLine)
  51 pairP = (,) <$> (packetP <* endOfLine) <*> packetP
  52
  53 packetP = listP <|> elementP
  54 elementP = Element <$> decimal
  55 listP = List <$> ("[" *> (packetP `sepBy` ",")) <* "]"
  56
  57 successfulParse :: Text -> [(Packet, Packet)]
  58 successfulParse input =
  59   case parseOnly pairsP input of
  60     Left  _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
  61     Right pairs -> pairs