47 lines
1.7 KiB
Haskell
47 lines
1.7 KiB
Haskell
|
{-# 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
|