d0d616a874d65414360fb18dbbf62e5bb0f647d4
1 -- import Debug.Trace
3 import Data.Text (Text)
4 import qualified Data.Text.IO as TIO
6 import Data.Void (Void)
8 import Text.Megaparsec hiding (State)
9 import Text.Megaparsec.Char
10 import qualified Text.Megaparsec.Char.Lexer as L
11 import qualified Control.Applicative as CA
14 import Data.Finite (Finite, modulo, getFinite)
15 import Data.Group (Group(..), pow)
16 import GHC.TypeNats (KnownNat)
18 import Data.Foldable (fold)
21 data ShuffleOp = Cut Integer
22 | Increment Integer
23 | Stack
24 deriving (Eq, Ord, Show)
26 type Shuffle = [ShuffleOp]
28 data Affine n = Affine { affA :: !(Finite n)
29 , affB :: !(Finite n)
30 } deriving (Eq, Ord, Show)
33 instance KnownNat n => Semigroup (Affine n) where
34 Affine a2 b2 <> Affine a1 b1 = Affine (a2 * a1) (a2 * b1 + b2)
36 instance KnownNat n => Monoid (Affine n) where
37 mempty = Affine 1 0
39 instance KnownNat n => Group (Affine n) where
40 invert (Affine a b) = Affine a' b'
41 where
42 a' = a ^ (maxBound @(Finite n) - 1)
43 b' = negate (a' * b)
46 main :: IO ()
47 main = do
49 let shuffle = successfulParse text
50 print \$ part1 shuffle
51 print \$ part2 shuffle
54 part1 shuffle = getFinite \$ trans @\$ 2019
55 where trans = mergeOps \$ map affOfOp shuffle :: Affine 10007
57 part2 shuffle = getFinite \$ invert bigTrans @\$ 2020
58 where trans = mergeOps \$ map affOfOp shuffle :: Affine 119315717514047
59 bigTrans = trans `pow` 101741582076661
63 affOfOp :: KnownNat n => ShuffleOp -> Affine n
64 affOfOp (Cut c) = Affine 1 (negate (modulo c))
65 affOfOp (Increment i) = Affine (modulo i) 0
66 affOfOp Stack = Affine (modulo -1) (modulo -1)
68 mergeOps :: KnownNat n => [Affine n] -> Affine n
69 mergeOps = fold . reverse
71 -- given a transformation, where does the item at x end up?
72 (@\$) :: KnownNat n => Affine n -> Finite n -> Finite n
73 Affine a b @\$ x = a * x + b
76 -- Parse the input file
77 type Parser = Parsec Void Text
79 sc :: Parser ()
80 sc = L.space (skipSome spaceChar) CA.empty CA.empty
81 -- sc = L.space (skipSome (char ' ')) CA.empty CA.empty
83 lexeme = L.lexeme sc
84 integer = lexeme L.decimal
85 signedInteger = L.signed sc integer
86 symb = L.symbol sc
87 cutSP = symb "cut"
88 dealIncrementP = symb "deal with increment"
89 dealIntoP = symb "deal into new stack"
91 cutP = Cut <\$> (cutSP *> signedInteger)
92 incrementP = Increment <\$> (dealIncrementP *> signedInteger)
93 stackP = Stack <\$ dealIntoP
95 shuffleOpP = cutP <|> incrementP <|> stackP
97 shuffleP = many shuffleOpP
99 -- successfulParse :: Text -> [Vec]
100 successfulParse :: Text -> Shuffle
101 successfulParse input =
102 case parse shuffleP "input" input of
103 Left _err -> [] -- TIO.putStr \$ T.pack \$ parseErrorPretty err
104 Right shuffle -> shuffle