From 5b31f9effb571f1b33f15f8fd89063f936cb8599 Mon Sep 17 00:00:00 2001
From: Gattix <gattix@cock.li>
Date: Sun, 24 Dec 2023 23:40:18 +0100
Subject: [PATCH] day 15

---
 2023/day15/day15.hs | 40 ++++++++++++++++++----------------------
 1 file changed, 18 insertions(+), 22 deletions(-)

diff --git a/2023/day15/day15.hs b/2023/day15/day15.hs
index 4c6dd47..ed93310 100644
--- a/2023/day15/day15.hs
+++ b/2023/day15/day15.hs
@@ -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