I must admit, I cheated when doing day 22. I looked at the problem description and, while Part 1 might be solvable as a direct approach, just knew that Part 2 would be so much larger that it would require a different approach, probably involving bits of abstract algebra I've either forgotten or never knew.
I was right.
As this day involved both bits of discrete maths and bits of Haskell that were new to me, I cribbed mercilessly from mstksg's excellent description of how they solved it. This involved two main innovations:
- Dependent types to create a new type of integers modulo n
- The use of the concepts of a group to represent the shuffle as a function, not a series of operations.
I'm using the dependent types to make the modular arithmetic a bit tidier. When using numbers of type Finite n (natural numbers mod n), all arithmetic using these numbers is automatically taken mod n, without needed to scatter mod calls through things. But this is under-using their power: see the posts by Justin Le on type-safe neural networks for a better example. He uses the dependent types to describe matrices, and that means the type checker will ensure that only matrices of the correct sizes are added and multiplied together.
Each of the steps in the shuffle is an affine permutation of the deck of cards: the card at position x ends up at position a x + b (modulus the deck size). It turns out that affine permutations (with composition) form a group, and that will help me a lot in in a moment.
Data structures and parsing
Let's start by defining some data structures. ShuffleOp will store the results of parsing the input file. Affine is an affine permutation of the deck, characterised by the a and b values.
data ShuffleOp = Cut Integer
| Increment Integer
| Stack
deriving (Eq, Ord, Show)
type Shuffle = [ShuffleOp]
data Affine n = Affine { affA :: !(Finite n)
, affB :: !(Finite n)
} deriving (Eq, Ord, Show)
Parsing the data file is straightforward with Megaparsec. I define a symbol for each prefix of the instruction line, and parse the remainder into the ShuffleOp data.
lexeme = L.lexeme sc
integer = lexeme L.decimal
signedInteger = L.signed sc integer
symb = L.symbol sc
-- prefixes of each instruction
cutSP = symb "cut"
dealIncrementP = symb "deal with increment"
dealIntoP = symb "deal into new stack"
-- parsing each instruction type is "accept the prefix, capture the number"
cutP = Cut <$> (cutSP *> signedInteger)
incrementP = Increment <$> (dealIncrementP *> signedInteger)
stackP = Stack <$ dealIntoP
shuffleOpP = cutP <|> incrementP <|> stackP
shuffleP = many shuffleOpP
The operations convert into affine permuations quite easily (with modulo to convert the Integer into Finite n values).
affOfOp :: KnownNat n => ShuffleOp -> Affine n
affOfOp (Cut c) = Affine 1 (negate (modulo c))
affOfOp (Increment i) = Affine (modulo i) 0
affOfOp Stack = Affine (modulo -1) (modulo -1)
Permutation as a function
We can think of a permutation as a function that takes an object in position x and returns the position where it ends up. In this case, I define it as the operator @$
-- given a transformation, where does the item at x end up?
(@$) :: KnownNat n => Affine n -> Finite n -> Finite n
Affine a b @$ x = a * x + b
I can find the whole deck of cards by finding where each card ends up (using getFinite to convert the finite n values back to ordinary numbers):
> [getFinite $ transform @$ x | x <- [0..9]]
[7,4,1,8,5,2,9,6,3,0]
This says that the card that started in position 0 ends up in position 7, the card that started in position 1 ends up in position 4, and so on. If I want the deck order, I need to attach the cards to each position, sort by positions then extract the cards:
> map (getFinite . snd) $ sort [(transform @$ x, x) | x <- [0..9]]
[9,2,5,8,1,4,7,0,3,6]
This matches one of the examples in the problem specification.
Group properties
Mathematicians start with groups and then weaken their properties, if needed. Haskell starts with the weaker versions and builds on them to get the stronger objects.
A semigroup is a set of "things" (in this case, permutations of a deck of cards) and an operation that combines the things (in this case, composition), such that the result of the operation is also in the set of things (the set is closed under the operation).
In this case, if we have π as one permutation (shuffle) and σ as another; the composition π(σ(deck)) is also a permutation. I can write the composition as \(\pi \cdot \sigma\); in Haskell I'd write it as pi <> sigma . In fact, if π and σ are affine permutations, then \(\pi \cdot \sigma \) is also an affine permutation.
Another thing about semigroups is that the operation is associative, so \((\pi \cdot \sigma) \cdot \tau = \pi \cdot (\sigma \cdot \tau) = \pi \cdot \sigma \cdot \tau \).
A monoid is a semigroup with an additional feature, an identity element for the operation. It's often written as 1, for the analogy with multiplication. The law is that \(\pi \cdot 1 = 1 \cdot \pi = \pi \). In Haskell, the identity element is called mempty.
Finally, a group is a monoid where every element has an inverse: \(\pi \cdot \pi^{-1} = 1\) and the inverse is also in the group.
instance KnownNat n => Semigroup (Affine n) where
Affine a2 b2 <> Affine a1 b1 = Affine (a2 * a1) (a2 * b1 + b2)
instance KnownNat n => Monoid (Affine n) where
mempty = Affine 1 0
instance KnownNat n => Group (Affine n) where
invert (Affine a b) = Affine a' b'
where
a' = a ^ (maxBound @(Finite n) - 1)
b' = negate (a' * b)
(I won't go into the details of the maths of how those formulae are derived.)
All these classes are instances of Foldable, so the default definition of fold will combine all the shuffle operations for me. (But I have to be careful: the standard way of writing permutation composition, \(\pi \cdot \sigma \), applies π to the result of applying σ, so I have to reverse the lines of the input file to ensure they're combined in the right order.) I also need the type declaration to ensure the function doesn't get specialised for the first type of Affine it sees.
mergeOps :: KnownNat n => [Affine n] -> Affine n
mergeOps = fold . reverse
The other thing that Semigroup defines is stimes for combining several copies of an element; it's renamed mtimes in Monoid and pow in Group. It exploits the associative nature of the operation to make this efficient. If you can put the brackets where you like, you can rewrite π10 as π10 = π8 π2 = (π4 π4) π2 = ((π2 π2) (π2 π2)) π2. And that means I can calculate π10 by calculating π2, π4, and π8, then combining π8 an π4, four multiplications rather than the 9 needed for a direct fold.
And that's it. The final solution is just putting the pieces together.
part1 shuffle = getFinite $ trans @$ 2019
where trans = mergeOps $ map affOfOp shuffle :: Affine 10007
part2 shuffle = getFinite $ invert bigTrans @$ 2020
where trans = mergeOps $ map affOfOp shuffle :: Affine 119315717514047
bigTrans = trans `pow` 101741582076661
Code
You can find the entire code online, and on Github.