blob: 9469d71c04840bf6808d93b56c2802fbb664ce08 (
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
|
import Control.Monad
import Data.Char
import Data.List
import Data.Maybe
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
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]
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 ['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
main :: IO ()
main = do
input <- liftM (map parse . splitOn ',' . strip) (readFile "16.in")
print (foldl exec (State [0..15]) input)
|
