Day 16 - how to do part 2 without taking 3 years ��

16.hs

@@ -0,0 +1,47 @@
+{-# LANGUAGE BangPatterns #-}
+import Data.List (foldl')
+import Data.List.Split (splitOn)
+import Data.Char (ord, chr)
+import Data.Bits ((.&.))
+import Data.Function ((&))
+import Data.Bimap (Bimap, fromList, toAscList, (!), (!>), insert)
+import qualified Data.Bimap as B (map)
+
+type Programs = Bimap Int Int
+type Lookup   = Programs -> Int -> Int
+type Insert   = Int -> Int -> Programs -> Programs
+
+spin :: Int -> Programs -> Programs
+spin s = B.map (\v -> (v + s) .&. 15)
+
+swap :: Lookup -> Insert -> Int -> Int -> Programs -> Programs
+swap (!!!) ins keyX keyY bimap =
+    ins keyX (bimap !!! keyY) . ins keyY (bimap !!! keyX) $ bimap
+
+parseMove :: String -> Programs -> Programs
+parseMove str =
+    let exchange = swap (!)  insert
+        partner  = swap (!>) insertR
+    in  case head str of
+        's' ->  spin . read $ tail str
+        'x' ->  let x    :    y : [] = splitOn "/" $ tail str
+                in  exchange (read x)          (read y)
+        'p' ->  let p : '/' : q : [] = tail str
+                in  partner  (ord p - ord 'a') (ord q - ord 'a')
+    where insertR b a = insert a b
+
+dance :: [Programs -> Programs] -> Programs -> Programs
+dance moves programs = foldl' (&) programs moves
+
+danceN :: [Programs -> Programs] -> Programs -> Int -> Programs
+danceN _     programs 0 = programs
+danceN moves programs n = let !newPrograms = dance moves programs in danceN moves newPrograms (n-1)
+
+getOrder :: Programs -> String
+getOrder = map (chr . (+ ord 'a') . snd) . toAscList
+
+main :: IO ()
+main = do
+    moves <- fmap (map parseMove . splitOn ",") $ readFile "16.txt"
+    print $ getOrder $ dance  moves (fromList $ zip [0..15] [0..15])
+    --print $ getOrder $ danceN moves (fromList $ zip [0..15] [0..15]) 1000000000