Gattix/AoC
3
0
Fork 0
Code Issues 1 Pull Requests Releases Wiki Activity

day 15

This commit is contained in:
Gattix 2023-12-24 23:40:18 +01:00
parent be9d88184c
commit 5b31f9effb
1 changed files with 18 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

40
2023/day15/day15.hs
View File

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