January 12, 2020
in
#advent of code
#haskell

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.

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)
```

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.

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
```

You can find the entire code online, and on Github.