ionchy
/
adventofcode
1
0
Fork 0
Code

Day 16 - finally!

This commit is contained in:
Jonathan Chan 2017-12-17 11:55:59 -08:00
parent 45d8cfc46e
commit c585f7d7ba
1 changed files with 27 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

52
16.hs
View File

@ -1,33 +1,30 @@
{-# LANGUAGE BangPatterns #-} import Data.List (foldl', elemIndex)
import Data.List (foldl')
import Data.List.Split (splitOn) import Data.List.Split (splitOn)
import Data.Bits ((.&.))
import Data.Function ((&)) import Data.Function ((&))
import Data.Bimap (Bimap, fromList, toAscList, (!), (!>), insert) import Data.Map.Strict (Map, (!), insert, fromList, toList, toAscList)
type Programs = Bimap Int Char type Positions = Map Int Int
type State = (Int, Programs) type Swaps = Map Char Char
type State = (Int, Positions, Swaps)
(%) = mod
exchange :: Int -> Int -> State -> State exchange :: Int -> Int -> State -> State
exchange x y (s, programs) = exchange x y (s, positions, swaps) =
let spunX = (x + 16 - s) .&. 15 let spunX = (x + 16 - s) % 16
spunY = (y + 16 - s) .&. 15 spunY = (y + 16 - s) % 16
in (s, insert spunX (programs ! spunY) . insert spunY (programs ! spunX) $ programs) in (s, insert spunX (positions ! spunY) . insert spunY (positions ! spunX) $ positions, swaps)
partner :: Char -> Char -> State -> State partner :: Char -> Char -> State -> State
partner p q (s, programs) = partner p q (s, positions, swaps) =
(s, insert (programs !> q) p . insert (programs !> p) q $ programs) (s, positions, insert p (swaps ! q) . insert q (swaps ! p) $ swaps)
addSpin :: Int -> State -> State spin :: Int -> State -> State
addSpin s' (s, p) = ((s + s') .&. 15, p) spin s' (s, positions, swaps) = ((s + s') % 16, positions, swaps)
spin :: Int -> String -> String
spin s str = drop (16 - s) str ++ take (16 - s) str
parseMove :: String -> State -> State parseMove :: String -> State -> State
parseMove str = parseMove str =
case head str of case head str of
's' -> addSpin . read $ tail str '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
@ -36,14 +33,19 @@ parseMove str =
dance :: [State -> State] -> State -> State dance :: [State -> State] -> State -> State
dance moves state = foldl' (&) state moves dance moves state = foldl' (&) state moves
danceN :: [State -> State] -> State -> Int -> State applyDance :: State -> String -> String
danceN _ state 0 = state applyDance (s, positions, swaps) str =
danceN moves state n = let !newState = dance moves state in danceN moves newState (n-1) let positionsList = snd . unzip . toAscList $ positions
swapsReversed = fromList . (uncurry $ flip zip) . unzip . toList $ swaps
getOrder :: State -> String in map (swapsReversed !) . (drop (16 - s) <++> take (16 - s)) . map (str !!) $ positionsList
getOrder (s, programs) = spin s . snd . unzip . toAscList $ programs where (f <++> g) p = f p ++ g p
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 $ danceN moves (0, fromList $ zip [0..15] ['a'..'p']) 1 let ip = [0..15]; ap = ['a'..'p']
state = dance moves (0, fromList $ zip ip ip, fromList $ zip ap ap)
dances = iterate (applyDance state) ap
Just cycleSize = (+ 1) <$> (elemIndex ap $ tail dances)
print $ dances !! 1
print $ dances !! (1000000000 % cycleSize)