blob: 7f343b24cb9c40e88304d6f621561984e95ab166 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
|
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
import Data.Monoid
splitOn :: Eq a => a -> [a] -> [[a]]
splitOn c xs = case break (== c) xs of
(pre, []) -> [pre]
(pre, _ : post) -> pre : splitOn c post
strip :: String -> String
strip = dropWhile isSpace . reverse . dropWhile isSpace . reverse
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) | [a, b] <- splitOn '/' s = Exch (read a) (read b)
parse ['p', a, '/', b] = Part (ord a - ord 'a') (ord b - ord 'a')
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")
let d = makeDance input
print (dance d (State [0..15]))
print (dance (mtimes 1000000000 (makeDance input)) (State [0..15]))
|
