advent10/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2021/12/10/advent-of-code-2021-day-10/
   2
   3 import qualified Data.Map.Strict as M
   4 import Data.List
   5
   6 -- data ParseState = ParseState [Char] String -- expected closer stack, remaining text
   7
   8 data ParseResult = Complete String -- remaining text
   9   | Incomplete [Char] -- remaining closing chars
  10   | Corrupted [Char] String -- remaining closing chars, remaining text
  11   deriving (Eq, Ord, Show)
  12
  13 closingChars :: M.Map Char Char
  14 closingChars = M.fromList
  15   [ ('(', ')')
  16   , ('[', ']')
  17   , ('{', '}')
  18   , ('<', '>')
  19   ]
  20
  21 main :: IO ()
  22 main =
  23   do  text <- readFile "data/advent10.txt"
  24       let commands = lines text
  25       let parsedCommands = map parseLine commands
  26       print $ part1 parsedCommands
  27       print $ part2 parsedCommands
  28
  29 part1 :: [ParseResult] -> Int
  30 part1 parsedCommands = sum $ map scoreIllegal corruptChar
  31   where corrupts = filter isCorrupt parsedCommands
  32         corruptChar = map extractCorrupt corrupts
  33
  34 part2 :: [ParseResult] -> Int
  35 part2 parsedCommands = sortedScores !! (length scores `div` 2)
  36   where scores = map scoreIncompleteString $ filter isIncomplete parsedCommands
  37         sortedScores = sort scores
  38
  39 isCorrupt :: ParseResult -> Bool
  40 isCorrupt (Corrupted _ _) = True
  41 isCorrupt _ = False
  42
  43 isIncomplete :: ParseResult -> Bool
  44 isIncomplete (Incomplete _) = True
  45 isIncomplete _ = False
  46
  47 extractCorrupt :: ParseResult -> Char
  48 extractCorrupt (Corrupted _ (c:_)) = c
  49 extractCorrupt _ = ' '
  50
  51 scoreIllegal :: Char -> Int
  52 scoreIllegal ')' = 3
  53 scoreIllegal ']' = 57
  54 scoreIllegal '}' = 1197
  55 scoreIllegal '>' = 25137
  56 scoreIllegal _ = 0
  57
  58 scoreIncomplete :: Char -> Int
  59 scoreIncomplete ')' = 1
  60 scoreIncomplete ']' = 2
  61 scoreIncomplete '}' = 3
  62 scoreIncomplete '>' = 4
  63 scoreIncomplete _ = 0
  64
  65 scoreIncompleteString :: ParseResult -> Int
  66 scoreIncompleteString (Incomplete chars) = foldl' buildScore 0 $ map scoreIncomplete chars
  67   where buildScore total this = total * 5 + this
  68 scoreIncompleteString _ = 0
  69
  70
  71 parseLine :: String -> ParseResult
  72 parseLine [] = Complete ""
  73 parseLine command = case chunk of
  74         Complete remaining -> parseLine remaining
  75         _ -> chunk
  76   where chunk = parseChunk0 command
  77
  78 parseChunk0 :: String -> ParseResult
  79 parseChunk0 [] = Complete ""
  80 parseChunk0 (next:remaining) = case M.lookup next closingChars of
  81   Just nextCloser -> parseChunk [nextCloser] remaining
  82   Nothing -> Corrupted [] (next:remaining)
  83
  84 parseChunk :: [Char] -> String -> ParseResult
  85 parseChunk [] remaining = Complete remaining
  86 parseChunk stack [] = Incomplete stack
  87 parseChunk (closer:stack) (next:remaining)
  88   | next == closer = parseChunk stack remaining -- expected closing character
  89   | otherwise = case M.lookup next closingChars of
  90           -- next is a new opening character
  91           Just nextCloser -> parseChunk (nextCloser:closer:stack) remaining
  92           -- wrong character
  93           Nothing -> Corrupted (closer:stack) (next:remaining)