### Advent of Code 2020 review

A look back on the event

Starting simple, then changing direction for performance

Day 23 is one where the the obvious approach works fine for the small problem in part 1, but doesn't scale to the larger problem in part 2. But I think it's interesting to cover both, so this is a post of two parts.

This uses an obvious representation for the circle of cups, a circular pointed list. This is an example of a zipper, a data structure with one element picked out as a focus. In this case, the focus of the pointed list is the current element. Functions like `previous`

and `next`

move the focus, and you can insert and delete elements from the list. This is a natural fit to the "circle of labelled things" in the problem.

I needed to remove and re-insert three items, so I quickly whipped up `takeRight`

and `dropRight`

functions to help that.

```
takeRight :: Int -> P.PointedList a -> [a]
takeRight 0 _ = []
takeRight n xs = (xs ^. P.focus):(takeRight (n - 1) $ P.next xs)
dropRight :: Int -> P.PointedList a -> Maybe (P.PointedList a)
dropRight 0 xs = Just xs
dropRight n xxs = case (P.deleteRight xxs) of
Just xs -> dropRight (n - 1) xs
Nothing -> Nothing
```

(Note the use of a lens `^.`

to get the focused element; see AoC 2019 day 23 for more use of lenses.)

I also needed something to find valid destinations

```
validDestination 0 max missing = validDestination max max missing
validDestination n max missing
| n `elem` missing = validDestination (n - 1) max missing
| otherwise = n
```

The main "play one step of the game" function is a fairly direct translation of the steps into code, inserting deleting and shifting as needed.

```
playOne cups = P.next replacedAtCurrent
where current = cups ^. P.focus
held = takeRight 3 $ P.next cups
shorter = fromJust $ dropRight 3 $ P.next cups
destination = validDestination (current - 1) 9 held
shorterAtDestination = fromJust $ P.find destination shorter
replaced = foldr P.insertRight shorterAtDestination $ reverse held
replacedAtCurrent = fromJust $ P.find current replaced
```

Finally, a bit of plumbing to connect the input to the solution

```
part1 nums = label $ playN cups 100
where cups = fromJust $ P.fromList nums
label cups = concatMap show $ tail $ takeRight (P.length cups) atOne
where atOne = fromJust $ P.find 1 cups
playN cups n = (iterate playOne cups) !! n
```

This scaled up from ten cups and one hundred rounds to one million cups and ten million rounds. A pointed list wasn't going to cope. But as all the moves were "what's the next cup around the circle", a circular linked list would be enough, if I could make the pointer updates happen in a mutable structure (much like day 15). It's easier to work through the updates, and the intermediate pointers needed, with an example.

I start with the cups after the first move of the example. Given the **current** cup, I can pick the first **held** cup and the first cup **after the held** ones.

I can then splice out the **held** cups by making **current** point to **after held**. I then identify the **destination** cup (and the cup **after the destination**).

Then I do the other pointer updates. **Destination** now points to **held**, and the last **held** cup points to the cup **after the destination**.

If I neaten that up a bit, I show the result after the move, ready for **current** to move on one cup.

Now I know what I'm doing, I just need to implement it. First, I need to decide on a data structure. Each cup has an index and a pointer to the next cup, and that's all. That suggests using a `Vector`

, where the contents of `cups[i]`

is the *next* cup from cup *i*. The state at in the last diagram above would be like this:

Index | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
---|---|---|---|---|---|---|---|---|---|

3 | 5 | 2 | 6 | 4 | 7 | 8 | 9 | 1 |

After cup 1 comes cup 3; after cup 2 comes cup 5; and so on.

I also saw a suggestion (from somewhere) that keeps things a bit neater. Vectors have zero-based indexing, but I want to use one-based indexing for the pointers. I can repurpose `cups[0]`

to be a pointer to the **current** cup.

Index | 0 | 1 | 2 | 3 | 4 | 5 | 6 | 7 | 8 | 9 |
---|---|---|---|---|---|---|---|---|---|---|

2 | 3 | 5 | 2 | 6 | 4 | 7 | 8 | 9 | 1 |

After all of that, the code for each game step update follows from the description.

```
gameStep :: Int -> V.MVector s Int -> ST s ()
gameStep maxCups cups =
do current <- V.read cups 0
held1 <- V.read cups current
held2 <- V.read cups held1
held3 <- V.read cups held2
afterHeld <- V.read cups held3
-- close the loop, removing the held cups
V.write cups current afterHeld
let destination =
validDestination (current - 1) maxCups [held1, held2, held3]
afterDestination <- V.read cups destination
-- make the held come after the destination
V.write cups destination held1
-- make the end of the held point into the rest of the loop
V.write cups held3 afterDestination
-- advance current
nextCup <- V.read cups current
-- and store it
V.write cups 0 nextCup
return ()
```

There's also a bit of setup to create the initial vector then run the game.

```
runGame :: [Int] -> Int -> Int -> [Int]
runGame seed cupsNeeded roundsNeeded =
runST $
do cups <- seedGame seed cupsNeeded
gameLoop roundsNeeded cupsNeeded cups
mapM (V.read cups) [0..cupsNeeded]
seedGame :: [Int] -> Int -> ST s (V.MVector s Int)
seedGame seed cupsNeeded =
do cups <- V.new (cupsNeeded + 1)
let extended = seed ++ [10, 11..]
forM_ [0..cupsNeeded] $ \i -> V.write cups i (i + 1)
forM_ (zip seed $ tail extended) $ \(i, j) -> V.write cups i j
V.write cups 0 (head seed)
let end = if cupsNeeded > (length seed)
then cupsNeeded
else last seed
V.write cups end (head seed)
return cups
gameLoop targetRound maxCups cups =
do forM_ [1..targetRound]
(\_ -> gameStep maxCups cups)
return ()
```

It takes about 1.8 seconds to run both parts.

You can find the code here or on GitLab.