This commit is contained in:
Gattix 2023-12-24 23:40:18 +01:00
parent be9d88184c
commit 5b31f9effb

View File

@ -1,4 +1,5 @@
import Control.Arrow
import Control.Lens
import Data.Function
import Data.List
import Data.List.Split
@ -8,7 +9,7 @@ import Text.Read
type HASH = (String, Maybe Int)
main :: IO ()
main = interact $ show . genBuckets . parse . init
main = interact $ show . (day15a &&& day15b . parse) . init
parse :: String -> [HASH]
parse = map (second (readMaybe . tail) . break (`elem` "=-")) . splitOn ","
@ -16,28 +17,23 @@ parse = map (second (readMaybe . tail) . break (`elem` "=-")) . splitOn ","
day15a :: String -> Int
day15a = sum . map (foldl' hashAlg 0) . splitOn ","
day15b :: [HASH] -> Int
day15b =
sum .
zipWith (*) [1 ..] .
map (sum . zipWith (*) [1 ..] . map (fromJust . snd)) .
foldl' processInstruction (replicate 256 [])
hashAlg :: Int -> Char -> Int
hashAlg x y = (17 * (fromEnum y + x)) `mod` 256
removeHashes :: [String] -> [HASH] -> [HASH]
removeHashes _ [] = []
removeHashes rs ((label, Nothing):xs) = removeHashes (label : rs) xs
removeHashes rs ((label, Just x):xs)
| label `elem` rs = removeHashes (delete label rs) xs
| otherwise = (label, Just x) : removeHashes rs xs
genBuckets :: [HASH] -> Int
genBuckets input =
sum
[ sum $ zipWith (*) [1 ..] $ map ((* (succ x)) . fromJust . snd) (sorted x)
| x <- [0 .. 255]
]
processInstruction :: [[HASH]] -> HASH -> [[HASH]]
processInstruction bs (s, action) = (element box .~ l) bs
where
filterBucket x f =
nubBy ((==) `on` fst) $
f $ removeHashes [] (reverse $ filter (f1 x) input)
sorted x =
sortOn
(\y -> fst y `elemIndex` (map fst (filterBucket x reverse)))
(filterBucket x id)
f1 n (x, _) = foldl hashAlg 0 x == n
mInsert x = uncurry (++) . second (f x) . break (((==) `on` fst) x)
f a (_:xs) = a : xs
f a [] = [a]
box = foldl' hashAlg 0 s
newList = mInsert (s, action) (bs !! box)
newDelList = deleteBy ((==) `on` fst) (s, action) (bs !! box)
l = maybe newDelList (const newList) action