advent-of-code/2023/haskell/solutions/Day15.hs
2023-12-16 11:46:07 +01:00

71 lines
1.9 KiB
Haskell

{-# LANGUAGE OverloadedStrings #-}
module Day15 (parse, solveA, solveB) where
import Data.Void (Void)
import Data.Text (Text)
import qualified Data.Text as T
import Data.Char (ord, isSpace)
import Data.Bifunctor (bimap)
import Text.Megaparsec (Parsec, errorBundlePretty, runParser, sepBy, optional, eof, many, choice)
import Text.Megaparsec.Char (newline, alphaNumChar, char)
import Text.Megaparsec.Char.Lexer (decimal)
import Lens.Micro (ix, (%~))
data Op
= Set Text Int
| Del Text
deriving Show
type Entry = (Text, Int)
type Parser = Parsec Void Text
parse :: Text -> Either String [(Text, Op)]
parse text = bimap errorBundlePretty (zip . simple $ text) . runParser complex "" $ text
where
simple :: Text -> [Text]
simple = T.splitOn "," . T.filter (not . isSpace)
single :: Parser Op
single = do
label <- T.pack <$> many alphaNumChar
choice
[ Set label <$> (char '=' *> decimal)
, Del label <$ char '-'
]
complex :: Parser [Op]
complex = single `sepBy` "," <* optional newline <* eof
hash :: Text -> Int
hash = T.foldl step 0
where
step :: Int -> Char -> Int
step curr = (`rem` 256) . (17 *) . (curr +) . ord
solveA :: [(Text, Op)] -> Int
solveA = sum . map (hash . fst)
del :: Text -> [[Entry]] -> [[Entry]]
del k = ix (hash k) %~ filter ((k /=) . fst)
set :: Text -> Int -> [[Entry]] -> [[Entry]]
set k v = ix (hash k) %~ update
where
update :: [Entry] -> [Entry]
update es
| any ((k ==) . fst) es = map (\(k', v') -> if k == k' then (k, v) else (k', v')) es
| otherwise = es <> [(k, v)]
solveB :: [(Text, Op)] -> Int
solveB = sum . zipWith row [1..] . foldl (flip run) (replicate 256 []) . map snd
where
run :: Op -> [[Entry]] -> [[Entry]]
run op = case op of
Set k v -> set k v
Del k -> del k
box :: Int -> Entry -> Int
box i = (i *) . snd
row :: Int -> [Entry] -> Int
row i = (i *) . sum . zipWith box [1..]