A look back on the event
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
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
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
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:
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 to be a pointer to the current cup.
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.