-
Notifications
You must be signed in to change notification settings - Fork 5
/
Day16.hs
50 lines (40 loc) · 1.56 KB
/
Day16.hs
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
module AOC2017.Day16 (day16a, day16b) where
import AOC2017.Types (Challenge)
import Data.Char (chr, ord)
import Data.List.Split (splitOn)
import Data.Semigroup (Semigroup(..), stimes, Dual(..))
import qualified Data.Map as M
newtype Perm a = P { permMap :: M.Map a a }
deriving Show
lookupPerm :: Ord a => Perm a -> a -> a
lookupPerm p k = M.findWithDefault k k (permMap p)
instance Ord a => Semigroup (Perm a) where
x <> y = P $ (lookupPerm x <$> permMap y) `M.union` permMap x
instance Ord a => Monoid (Perm a) where
mappend = (<>)
mempty = P M.empty
type Dance = (Perm Int, Dual (Perm Char))
runDance :: Dance -> String
runDance (pI, pN) = lookupPerm (getDual pN)
. toName
. lookupPerm pI
<$> [0..15]
where
toName c = chr (c + ord 'a')
parseMove :: String -> Dance
parseMove = \case
's':(read->n) -> (rotator n , mempty )
'x':(map read.splitOn "/"->n:m:_) -> (swapper n m, mempty )
'p':n:_:m:_ -> (mempty , Dual (swapper n m))
_ -> error "No parse"
where
rotator :: Int -> Perm Int
rotator n = P $ M.fromList [ (i, (i - n) `mod` 16) | i <- [0..15] ]
swapper :: Ord a => a -> a -> Perm a
swapper x y = P $ M.fromList [ (x, y), (y, x) ]
parse :: String -> Dance
parse = foldMap parseMove . splitOn ","
day16a :: Challenge
day16a = runDance . parse
day16b :: Challenge
day16b = runDance . stimes (1e9 :: Int) . parse