advent15/Main.hs

   1 -- Writeup at https://work.njae.me.uk/2023/12/18/advent-of-code-2023-day-15/
   2
   3 import AoC
   4 import Data.List
   5 -- import Data.List.Split
   6 import Data.Char
   7
   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
  13
  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]
  17
  18 main :: IO ()
  19 main =
  20   do  dataFileName <- getDataFileName
  21       text <- TIO.readFile dataFileName
  22       let instructions = successfulParse text
  23       -- print instructions
  24       print $ part1 text
  25       print $ part2 instructions
  26
  27 -- part1, part2 :: [Pattern] -> Int
  28 part1 :: Text -> Int
  29 part1 = sum . fmap (hash . unpack) . splitOn ","
  30
  31 part2 :: [Instruction] -> Int
  32 part2 = power . processAll
  33
  34 hash :: String -> Int
  35 hash s = foldl' go 0 s
  36   where go current c = ((current + ord c) * 17)  `mod` 256
  37
  38 processAll :: [Instruction] -> Facility
  39 processAll = foldl' process M.empty
  40
  41 process :: Facility -> Instruction -> Facility
  42 process facility (Remove s) =
  43   M.adjust (filter ((/= s) . lensLabel))
  44            (hash s)
  45            facility
  46 process facility (Insert s p)
  47   | any ((== s) . lensLabel) content = M.insert hs content' facility
  48   | otherwise = M.insert hs (content ++ [lens]) facility
  49   where hs = hash s
  50         content = M.findWithDefault [] hs facility
  51         lens = Lens s p
  52         content' = fmap replaceLens content
  53         replaceLens l
  54           | lensLabel l == s = lens
  55           | otherwise = l
  56
  57 powerCell :: Int -> [Lens] -> Int
  58 powerCell boxNum lenses =
  59   (boxNum + 1) * (sum $ zipWith (*) [1..] (fmap lensPower lenses))
  60
  61 power :: Facility -> Int
  62 power = sum . M.elems . M.mapWithKey powerCell
  63
  64 -- Parse the input file
  65
  66 instructionsP :: Parser [Instruction]
  67 instructionP, removeP, insertP :: Parser Instruction
  68
  69 instructionsP = instructionP `sepBy` ","
  70 instructionP = removeP <|> insertP
  71
  72 removeP = Remove <$> (many1 letter) <* "-"
  73 insertP = Insert <$> ((many1 letter) <* "=") <*> decimal
  74
  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