Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25
Part 1
Day 23 throws yet another game at us, with a similar theme of moving-integers-around. This time, we need to pick up chunks and place them in the middle of a sequence, rather than always placing them at the end.
This sounds like a job for a linked list data structure, which supports O(1) insertion and deletion even in the middle of the list. (Those who have dabbled in competitive programming will know that it's hard for problem setters to write a problem that forces a linked list solution, so linked list problems tend to all look very similar, and are therefore pretty easy to recognize.)
It turns out that Haskell's lists are linked lists under the hood, but I was nervous about whether it would actually be suitable for this problem. The list type doesn't really support the efficient operations we need for this problem (and it seems pretty obvious that part 2 will force us to do this efficiently).
Instead, we will borrow the fundamental idea behind the linked list, but be a bit more clever. In a linked list, each element "points" to the next, and we make insertions and deletions by manipulating these pointers. Since our elements are a contiguous sequence of integers, we can use an index into a Vector as a proxy for our element value, and the storage of that vector as the pointer. For instance, take the problem's example of 3 -> 8 -> 9 -> 1 -> 2 -> 5 -> 4 -> 6 -> 7 -> 3 -> ..., which we can represent as:
[0, 2, 5, 8, 6, 4, 7, 3, 9, 1]
0: anything
1: 2
2: 5
3: 8
4: 6
5: 4
6: 7
7: 3
8: 9
9: 1
The 3rd element is 8, so 3 is followed by 8 in the list. The 8th element is 9, so 8 is followed by 9 in the list. The cycle can also be expressed, as the 7th element is 3, indicating that 7 is followed by 3 again. The entire game state can be represented as this Vector, plus an additional Int to indicating which is the current cup. The benefit of this approach is that it can perform the game operation with just three writes, with the rest of the Vector being untouched - no need to shuffle any of the other elements around in memory as we would for contiguous data structures. For example, the first round of the example would require the following three updates:
0: anything
1: 5 (was 2)
2: 8 (was 5)
3: 2 (was 8)
4: 6
5: 4
6: 7
7: 3
8: 9
9: 1
Let's write a couple of functions that help us work with this representation.
import Data.Vector ((//), (!))
import qualified Data.Vector as Vector
data GameState = GameState (Vector.Vector Int) Int deriving Show
initState :: [Int] -> GameState
initState l =
let pairs = zip l (tail l ++ [head l])
vec = (Vector.replicate (nCups + 1) 0) // pairs
in GameState vec (head l)
reconstruct :: GameState -> Int -> [Int]
reconstruct (GameState v curr) pos =
(v ! pos) : (reconstruct (GameState v curr) (v ! pos))
The initState function takes our input list and populates our game state vector. It uses the idiomatic trick of zipping a list with its tail to get a list of pairs of adjacent elements (appending the head to get the full cycle). This gives the pairs we need to pass to the (//) vector update operator. The current cup is initialized to the head of the input list.
We also write a reconstruct function that we'll need later, which reconstructs the list in sequence by following pointers. Since our game state vector should always represent a cycle, it generates an infinite list, but we'll only take what we need from it when printing out the final solution to Part 1.
import D23input
-- nCups :: Int
-- nSteps :: Int
-- input :: [Int]
data Picked = Picked Int Int Int
destLabel :: Picked -> Int -> Int
destLabel (Picked a b c) x
| xm1 /= a && xm1 /= b && xm1 /= c = xm1
| xm2 /= a && xm2 /= b && xm2 /= c = xm2
| xm3 /= a && xm3 /= b && xm3 /= c = xm3
| otherwise = xm4
where xm1 = if x == 1 then 9 else (x - 1)
xm2 = if xm1 == 1 then 9 else (xm1 - 1)
xm3 = if xm2 == 1 then 9 else (xm2 - 1)
xm4 = if xm3 == 1 then 9 else (xm3 - 1)
step :: GameState -> GameState
step (GameState v curr) =
let p1 = v ! curr
p2 = v ! p1
p3 = v ! p2
notPicked = v ! p3
dest = destLabel (Picked p1 p2 p3) curr
postDest = v ! dest
updateCurr = (curr, notPicked)
updateDest = (dest, p1)
updateP3 = (p3, postDest)
in GameState (v // [updateCurr, updateDest, updateP3]) notPicked
getNthState :: Int -> GameState -> GameState
getNthState n start = head $ drop n $ iterate step start
solve :: [Int]
solve =
let start = initState input
end = getNthState nSteps start
in take (nCups - 1) $ reconstruct end 1
main :: IO ()
main = print $ solve
The step function advances the game state by one round. We use the game state vector to determine the three elements that are picked by following the indices. We also note the first element that is not picked for later. From this, we can compute the destination element (the cup after which the picked sequence of 3 is to be placed) as dest, and also note the cup immediately after the destination cup. We now have all information we need make the three updates. Making the current cup point to the first cup next picked effectively removes the three cups out of the sequence. Making the destination cup point to the first cup of the sequence, and making the last cup of the sequence point to the cup after the destination cup effectively inserts the sequence back in at the appropriate spot.
destLabel is a helper function that takes the current cup as well as the three cups picked and computes the destination cup. It's a slightly awkward implementation, but we can get away with it here since we know there are only three cups picked.
Then, it's just a matter of running step the correct number of times and then reconstructing the sequence. We only take the first (nCups - 1) of the resulting infinite list, since the question only asks us to list the cups in order starting after cup 1.
Part 2
Predictably, part 2 asks us to increase the number of cups (to one million) and the number of steps (to ten million). I naively thought that our clever representation would allow part 2 to run as well with no problem, but I couldn't even get an answer without the binary consuming all the resources on my machine. I turned once again to mutable vector, which we saw in Day 15.
The solution is mostly the same, however. We need a slightly more complicated initialization, since we need to take care of the implicitly ordered cups. We also don't need a reconstruct function any more, since we only need the first two cups following cup 1.
I also repurposed the unused 0th element in the game state vector to point to the current cup, rather than carrying around a separate Int, just to simplify the types a little bit.
import D23input
-- nCups :: Int
-- nSteps :: Int
-- input :: [Int]
import qualified Data.List as List
import Control.Monad
import Control.Monad.ST
import Data.Vector.Unboxed.Mutable as MVector
data Picked = Picked Int Int Int
destLabel :: Picked -> Int -> Int
destLabel (Picked a b c) x
| xm1 /= a && xm1 /= b && xm1 /= c = xm1
| xm2 /= a && xm2 /= b && xm2 /= c = xm2
| xm3 /= a && xm3 /= b && xm3 /= c = xm3
| otherwise = xm4
where xm1 = if x == 1 then nCups else (x - 1)
xm2 = if xm1 == 1 then nCups else (xm1 - 1)
xm3 = if xm2 == 1 then nCups else (xm2 - 1)
xm4 = if xm3 == 1 then nCups else (xm3 - 1)
initState :: [Int] -> ST s (MVector.MVector s Int)
initState l = do
expanded <- pure $ l ++ [10..nCups]
v <- MVector.replicate (nCups + 1) 0
forM_ (List.zip expanded (List.tail expanded)) $ \(i,n) -> do
MVector.write v i n
MVector.write v (List.last expanded) (List.head expanded)
MVector.write v 0 (head expanded)
return v
makeMove :: MVector.MVector s Int -> ST s ()
makeMove v = do
curr <- MVector.read v 0
p1 <- MVector.read v curr
p2 <- MVector.read v p1
p3 <- MVector.read v p2
notPicked <- MVector.read v p3
dest <- pure $ destLabel (Picked p1 p2 p3) curr
postDest <- MVector.read v dest
MVector.write v curr notPicked
MVector.write v dest p1
MVector.write v p3 postDest
MVector.write v 0 notPicked
makeNMoves :: Int -> MVector.MVector s Int -> ST s ()
makeNMoves n v = do
forM_ [1..n] $ \_ ->
makeMove v
solve :: Int
solve = runST $ do
v <- initState input
makeNMoves nSteps v
x <- MVector.read v 1
y <- MVector.read v x
return (x * y)
main :: IO ()
main = print $ solve
Jump to:
D1 | D2 | D3 | D4 | D5 | D6 | D7 | D8 | D9 | D10 | D11 | D12 | D13 | D14 | D15 | D16 | D17 | D18 | D19 | D20 | D21 | D22 | D23 | D24 | D25