1 -- Writeup at https://work.njae.me.uk/2023/12/18/advent-of-code-2023-day-15/
5 -- import Data.List.Split
8 import Data.Text (Text, splitOn, unpack)
9 import qualified Data.Text.IO as TIO
10 import Data.Attoparsec.Text -- hiding (take, takeWhile)
11 import Control.Applicative
12 import qualified Data.IntMap.Strict as M
14 data Instruction = Remove String | Insert String Int deriving (Show, Eq)
15 data Lens = Lens {lensLabel :: String, lensPower :: Int} deriving (Show, Eq)
16 type Facility = M.IntMap [Lens]
20 do dataFileName <- getDataFileName
21 text <- TIO.readFile dataFileName
22 let instructions = successfulParse text
25 print $ part2 instructions
27 -- part1, part2 :: [Pattern] -> Int
29 part1 = sum . fmap (hash . unpack) . splitOn ","
31 part2 :: [Instruction] -> Int
32 part2 = power . processAll
35 hash s = foldl' go 0 s
36 where go current c = ((current + ord c) * 17) `mod` 256
38 processAll :: [Instruction] -> Facility
39 processAll = foldl' process M.empty
41 process :: Facility -> Instruction -> Facility
42 process facility (Remove s) =
43 M.adjust (filter ((/= s) . lensLabel))
46 process facility (Insert s p)
47 | any ((== s) . lensLabel) content = M.insert hs content' facility
48 | otherwise = M.insert hs (content ++ [lens]) facility
50 content = M.findWithDefault [] hs facility
52 content' = fmap replaceLens content
54 | lensLabel l == s = lens
57 powerCell :: Int -> [Lens] -> Int
58 powerCell boxNum lenses =
59 (boxNum + 1) * (sum $ zipWith (*) [1..] (fmap lensPower lenses))
61 power :: Facility -> Int
62 power = sum . M.elems . M.mapWithKey powerCell
64 -- Parse the input file
66 instructionsP :: Parser [Instruction]
67 instructionP, removeP, insertP :: Parser Instruction
69 instructionsP = instructionP `sepBy` ","
70 instructionP = removeP <|> insertP
72 removeP = Remove <$> (many1 letter) <* "-"
73 insertP = Insert <$> ((many1 letter) <* "=") <*> decimal
75 successfulParse :: Text -> [Instruction]
76 successfulParse input =
77 case parseOnly instructionsP input of
78 Left _err -> [] -- TIO.putStr $ T.pack $ parseErrorPretty err
79 Right matches -> matches