summaryrefslogtreecommitdiff
path: root/2017
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2017-12-16 11:42:06 +0100
committertomsmeding <tom.smeding@gmail.com>2017-12-16 11:54:11 +0100
commit5f6c480073be6f69e0e0f1241ac80e26245dd7a7 (patch)
tree0f392a29d4caa5629b5c9982fdbb2c3216549e9c /2017
parent6967e020b03b9bc57f48578ba36594cb873253dc (diff)
Day 16 b
Diffstat (limited to '2017')
-rw-r--r--2017/16.hs66
1 files changed, 48 insertions, 18 deletions
diff --git a/2017/16.hs b/2017/16.hs
index 9469d71..7f343b2 100644
--- a/2017/16.hs
+++ b/2017/16.hs
@@ -2,6 +2,7 @@ import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
+import Data.Monoid
splitOn :: Eq a => a -> [a] -> [[a]]
@@ -12,37 +13,66 @@ splitOn c xs = case break (== c) xs of
strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
-swap :: Int -> Int -> [a] -> [a]
-swap i j (hd:tl) = case (i, j) of
- (0, _) -> uncurry (:) (go (j-1) hd tl)
- (_, 0) -> uncurry (:) (go (i-1) hd tl)
- (_, _) -> hd : swap (i-1) (j-1) tl
- where
- go 0 v (hd:tl) = (hd, v : tl)
- go k v (hd:tl) = fmap (hd :) (go (k-1) v tl)
-
data Ins = Spin Int | Exch Int Int | Part Int Int
deriving Show
newtype State = State [Int]
+ deriving Eq
instance Show State where
show (State ar) = map (chr . (+ ord 'a')) ar
parse :: String -> Ins
parse ('s' : s) = Spin (read s)
-parse ('x' : s) = let [a, b] = splitOn '/' s in Exch (read a) (read b)
+parse ('x' : s) | [a, b] <- splitOn '/' s = Exch (read a) (read b)
parse ['p', a, '/', b] = Part (ord a - ord 'a') (ord b - ord 'a')
-exec :: State -> Ins -> State
-exec (State ar) (Spin n) = State $ take 16 (drop (16 - n) (cycle ar))
-exec (State ar) (Exch i j) = State $ swap i j ar
-exec (State ar) (Part a b) =
- let i = fromMaybe (-1) (findIndex (== a) ar)
- j = fromMaybe (-1) (findIndex (== b) ar)
- in State $ swap i j ar
+newtype Permutation = Permutation [Int]
+ deriving Show
+
+permute :: Permutation -> [a] -> [a]
+permute (Permutation p) ar = [ar !! i | i <- p]
+
+instance Monoid Permutation where
+ mempty = Permutation [0..15]
+ mappend a (Permutation b) = Permutation (permute a b)
+
+mtimes :: Monoid a => Int -> a -> a
+mtimes 0 _ = mempty
+mtimes 1 m = m
+mtimes n m
+ | even n = let m' = mtimes (n `quot` 2) m in m' <> m'
+ | odd n = m <> mtimes (pred n) m
+
+permExch :: Int -> Int -> Permutation
+permExch i j
+ | i > j = permExch j i
+ | otherwise = Permutation ([0..i-1] ++ [j] ++ [i+1..j-1] ++ [i] ++ [j+1..15])
+
+data Dance = Dance Permutation {- place permutation -}
+ Permutation {- name permutation -}
+ deriving Show
+
+instance Monoid Dance where
+ mempty = Dance mempty mempty
+ mappend (Dance pp1 np1) (Dance pp2 np2) = Dance (pp1 <> pp2) (np2 <> np1)
+
+makeDance :: [Ins] -> Dance
+makeDance = foldl add (Dance (Permutation [0..15]) (Permutation [0..15]))
+ where
+ add (Dance pp np) (Spin n) = Dance (Permutation ([16-n..15] ++ [0..15-n]) <> pp) np
+ add (Dance pp np) (Exch i j) = Dance (permExch i j <> pp) np
+ add (Dance pp np) (Part i j) = Dance pp (np <> permExch i j) -- for some reason, these are inverted.
+
+dance :: Dance -> State -> State
+dance (Dance pp np) (State ar) =
+ let names = permute np [0..15]
+ in State (map (names !!) (permute pp ar))
main :: IO ()
main = do
input <- liftM (map parse . splitOn ',' . strip) (readFile "16.in")
- print (foldl exec (State [0..15]) input)
+ let d = makeDance input
+ print (dance d (State [0..15]))
+
+ print (dance (mtimes 1000000000 (makeDance input)) (State [0..15]))