day 20

20-a.hs

@@ -1,13 +1,12 @@
 import Common
-import Data.List (elemIndex)
+import Data.List (elemIndex, intercalate)
 import Data.Maybe (fromJust)
 
 wrap :: Int -> Int -> Int
 wrap length index
   | index == 0 = length - 1
-  | index == length - 1 = 0
-  | index >= length = wrap length $ index - length
-  | index < 0 = wrap length $ index + length
+  | index >= length = wrap length $ index - length + 1
+  | index < 0 = wrap length $ index + length - 1
   | otherwise = index
 
 coordinates = [1000, 2000, 3000]
@@ -17,18 +16,25 @@ decrypt a = sum $ map test coordinates
   where
     test n = mixed !! (zeroIndex + n)
     zeroIndex = fromJust $ elemIndex 0 mixed
-    mixed = cycle $ foldl mix a a
+    mixed = cycle $ fst $ foldl step (a, indices) indices
 
+    indices = [0 .. len - 1]
     len = length a
 
-    mix :: [Int] -> Int -> [Int]
-    mix list x = newList
+    step :: ([Int], [Int]) -> Int -> ([Int], [Int])
+    step (values, indices) i = (mix values index value, mix indices index value)
       where
-        newList = listStart ++ x : listEnd
+        value = values !! index
+        index = fromJust $ elemIndex i indices
+
+    mix :: [Int] -> Int -> Int -> [Int]
+    mix list i x = newList
+      where
+        newList = listStart ++ value : listEnd
         (listStart, listEnd) = splitAt newIndex list'
-        newIndex = wrap (len - 1) $ oldIndex + x
-        list' = filter (/= x) list
-        oldIndex = fromJust $ elemIndex x list
+        newIndex = wrap len $ i + x
+        list' = (\(l, r) -> l ++ tail r) $ splitAt i list
+        value = list !! i
 
 main = interact $
   show

20-b.hs

@@ -0,0 +1,45 @@
+-- this is disgustingly slow but it Works
+-- i wish i had the energy to optimize this because it's very simple to do so
+
+import Common
+import Data.List (elemIndex, intercalate)
+import Data.Maybe (fromJust)
+
+wrap :: Int -> Int -> Int
+wrap length index = index `mod` (length - 1)
+
+coordinates = [1000, 2000, 3000]
+key = 811589153
+
+decrypt :: [Int] -> Int
+decrypt a = sum $ map test coordinates
+  where
+    test n = mixed !! (zeroIndex + n)
+    zeroIndex = fromJust $ elemIndex 0 mixed
+    mixed = cycle $ fst $ iterateN mixList 10 (map (* key) a, allIndices)
+
+    mixList (values, indices) = foldl step (values, indices) allIndices
+
+    allIndices = [0 .. len - 1]
+
+    len = length a
+
+    step :: ([Int], [Int]) -> Int -> ([Int], [Int])
+    step (values, indices) i = (mix values index value, mix indices index value)
+      where
+        value = values !! index
+        index = fromJust $ elemIndex i indices
+
+    mix :: [Int] -> Int -> Int -> [Int]
+    mix list i x = newList
+      where
+        newList = listStart ++ value : listEnd
+        (listStart, listEnd) = splitAt newIndex list'
+        newIndex = wrap len $ i + x
+        list' = (\(l, r) -> l ++ tail r) $ splitAt i list
+        value = list !! i
+
+main = interact $
+  show
+  . decrypt
+  . map read . lines

Common.hs

@@ -48,11 +48,21 @@ gridHeight = length
 debug :: Show a => a -> ()
 debug = unsafePerformIO . print
 
+{-# NOINLINE debugS #-}
+debugS :: String  -> ()
+debugS = unsafePerformIO . putStrLn
+
 trace :: Show b => b -> a -> a
 trace s = deepseq (debug s)
 
+traceS :: String -> a -> a
+traceS s = deepseq (debugS s)
+
 count :: (a -> Bool) -> [a] -> Int
 count f = length . filter f
 
 trim :: String -> String
-trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+trim = reverse . dropWhile isSpace . reverse . dropWhile isSpace
+
+iterateN :: (a -> a) -> Int -> a -> a
+iterateN f n a = iterate f a !! n