ionchy
/
adventofcode
1
0
Fork 0
Code

Day 16 - part 2 still slow...

This commit is contained in:
Jonathan Chan 2017-12-16 22:30:06 -08:00
parent 5969de9996
commit e46dd27349
1 changed files with 30 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

54
16.hs
View File

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