Day 20 - Shifting Sequences

Dec 21

All 2022 Problems

Problem Overview

For this problem we are tracking a queue of numbers. We are constantly moving the numbers around in the queue, based on the value of the number itself. Our queue can also wrap around, so the items in the front might easily move to the back. In part 2, we have to apply our mixing algorithm multiple times, while keeping track of the order in which we move the numbers around.

Solution Approach and Insights

The logic for this problem is fairly intricate. You need to enumerate the cases and be very careful with your index and modulus operations. Off-by-1 errors are lurking everywhere! However, you don't need any advanced structures or logic to save time, because Haskell's Sequence structure is already quite good, allowing insertions and deletions from arbitrary indices in logarithmic time. My solution doesn't use any serious performance tricks and finishes in under 15 seconds or so.

Parsing the Input

For our input, we just get a signed number for each line.

The parsing code for this is near-trival.

type InputType = [Int]

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = sepEndBy1 parseSignedInteger eol

Part 1

In part 1, we loop through all the items of our queue in order. We shift each one by its index, and then continue until we've hit all the elements. The trick of course, is that the "last" item we look at might not be in the "last" location in the queue by the time we get to it. Everything is being shifted around, and so we have to account for that.

The "state" type for this problem will be our sequence of numbers AND a list of the indices of the numbers we still have to shift. Both of these are quite dynamic! But initializing them is easy. We take our inputs and convert to a sequence, and then we'll use 0..n as our initial set of indices.

type EasyState = (Seq.Seq Int, [Int])

initialEasy :: [Int] -> EasyState
initialEasy inputs = (Seq.fromList inputs, [0,1..(length inputs - 1)])

The core of the easy solution is a recursive helper that will process the next index we want to move. In the base case, there are no indices and we return the queue in its final state.

easyTail :: (MonadLogger m) => EasyState -> m (Seq.Seq Int)
easyTail (queue, []) = return queue
...

Our first job with the recursive case is to locate the value at the top index and delete it from the sequence.

easyTail :: (MonadLogger m) => EasyState -> m (Seq.Seq Int)
easyTail (queue, []) = return queue
easyTail (queue, nextIndex : restIndices) = do
  let val = Seq.index queue nextIndex
      queue' = Seq.deleteAt nextIndex queue
  ...

Now we determine the index where we want to insert this item. We'll add the value to the index and then take the modulus based on the length of the modified queue. That is, the modulus should be n - 1 overall. Remember, adding the value can cause the index to overflow in either direction, and we need to reset it to a position that is within the bounds of the sequence it is getting inserted into.

easyTail (queue, nextIndex : restIndices) = do
  let val = Seq.index queue nextIndex
      queue' = Seq.deleteAt nextIndex queue
      newIndex = (nextIndex + val) `mod` Seq.length queue'
      queue'' = Seq.insertAt newIndex val queue'
      ...

Now the last intricacy. When we insert an element later in the queue, we must bring forward the indices of all the elements that come before this new index. They are now in an earlier position relative to where they started. So we modify our indices in this way and then recurse with our new queue and indices.

easyTail :: (MonadLogger m) => EasyState -> m (Seq.Seq Int)
easyTail (queue, []) = return queue
easyTail (queue, nextIndex : restIndices) = do
  let val = Seq.index queue nextIndex
      queue' = Seq.deleteAt nextIndex queue
      newIndex = (nextIndex + val) `mod` Seq.length queue'
      queue'' = Seq.insertAt newIndex val queue'
      (indicesToChange, unchanged) = partition (<= newIndex) restIndices
  easyTail (queue'', map (\i -> i - 1) indicesToChange ++ unchanged)

To answer the question, we then run our tail recursive function to get the final sequence. Then we have to retrieve the index of the first place we see a 0 element.

type EasySolutionType = Int

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy inputs = do
  finalSeq <- easyTail (initialEasy inputs)
  let first0 = Seq.findIndexL (== 0) finalSeq
  ...

We need the 1000th, 2000th and 3000th indices beyond this, using mod to wrap around our queue as needed. We sum these values and return this number.

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy inputs = do
  finalSeq <- easyTail (initialEasy inputs)
  let first0 = Seq.findIndexL (== 0) finalSeq
  case first0 of
    Nothing -> logErrorN "Couldn't find 0!" >> return minBound
    Just i -> do
      let indices = map (`mod` Seq.length finalSeq) [i + 1000, i + 2000, i + 3000]
      return $ sum $ map (Seq.index finalSeq) indices

solveEasy :: FilePath -> IO (Maybe Int)
solveEasy fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  Just <$> processInputEasy input

This completes part 1.

Part 2

Part 2 contains a couple wrinkles. First, we'll multiply every number by a large number (811589153), so we'll start using Int64 to be safe. Second, we must run this process iteratively 10 times. Except we should always move the numbers in the same order. If the number 10 starts out in position 0, and gets moved to position 17 through the mixing process, we must still move that number first in each round.

This requires us to store each number's original index with it in the sequence as part of our state. Here's how we initialize it:

type HardState = (Seq.Seq (Int64, Int), [Int])

initialHard :: [Int] -> HardState
initialHard inputs = (Seq.fromList tuples, [0,1..(length inputs - 1)])
  where
    indices = [0,1..(length inputs - 1)]
    tuples = zip (map ((* 811589153) . fromIntegral) inputs) indices

Before we get further, Data.Seq doesn't have toList for some odd reason, so let's write it:

seqToList :: Seq.Seq a -> [a]
seqToList sequence = reverse $ foldl (flip (:)) [] sequence

Now we can write the vital function that will make this all work. The newIndices function will take a shifted sequence (where each number is paired with its original index), and determine the new ordering of indices in which to move the numbers from this sequence. This is a 3-step process:

Zip each value/index pair with its index in the new order.
Sort this zipped list based on the original index order
Source the fst values from the result.

Here's what that code looks like:

newIndices :: Seq.Seq (Int64, Int) -> [Int]
newIndices inputs = seqToList (fst <$> sortedByOrder)
  where
    zipped = Seq.zip (Seq.fromList [0,1..(Seq.length inputs - 1)]) inputs
    sortedByOrder = Seq.sortOn (snd . snd) zipped

Our primary tail recursive function now looks almost identical. All that's different is how we adjust the indices:

hardTail :: (MonadLogger m) => HardState -> m (Seq.Seq (Int64, Int))
hardTail (queue, []) = return queue
hardTail (queue, nextIndex : restIndices) = do
  let (val, order) = Seq.index queue nextIndex
      queue' = Seq.deleteAt nextIndex queue
      val' = fromIntegral (val `mod` fromIntegral (Seq.length queue'))
      newIndex = (nextIndex + val') `mod` Seq.length queue'
      queue'' = Seq.insertAt newIndex (val, order) queue'
      finalIndices = ...
  hardTail (queue'', finalIndices)

As with the easy part, the adjustment will reduce the index of all remaining indices that came before the new index we placed it at. What is different though is that if we move a value backward, we also have to increase the remaining indices that fall in between. This case couldn't happen before since we looped through indices in order. Here's the complete function.

hardTail :: (MonadLogger m) => HardState -> m (Seq.Seq (Int64, Int))
hardTail (queue, []) = return queue
hardTail (queue, nextIndex : restIndices) = do
  let (val, order) = Seq.index queue nextIndex
      queue' = Seq.deleteAt nextIndex queue
      val' = fromIntegral (val `mod` fromIntegral (Seq.length queue'))
      newIndex = (nextIndex + val') `mod` Seq.length queue'
      queue'' = Seq.insertAt newIndex (val, order) queue'
      finalIndices = adjustIndices nextIndex newIndex
  hardTail (queue'', finalIndices)
  where
    adjustIndices old new 
      | old > new = map (\i -> if i >= new && i < old then i + 1 else i) restIndices
      | old < new = map (\i -> if i <= new && i > old then i - 1 else i) restIndices
      | otherwise = restIndices

Now we write a function so we can run this process of moving the numbers and generating new indices as many times as we want:

solveN :: (MonadLogger m) => Int -> HardState -> m (Seq.Seq (Int64, Int))
solveN 0 (queue, _) = return queue
solveN n (queue, indices) = do
  newSet <- hardTail (queue, indices)
  let nextIndices = newIndices newSet
  solveN (n - 1) (newSet, nextIndices)

And we glue it together by solving 10 times and following the same process as the easy solution to get the final number.

type HardSolutionType = Int64

processInputHard :: (MonadLogger m) => InputType -> m HardSolutionType
processInputHard inputs = do
  finalSet <- solveN 10 (initialHard inputs)
  let first0 = Seq.findIndexL (\(v, _) -> v == 0) finalSet
  case first0 of
    Nothing -> logErrorN "Couldn't find 0!" >> return minBound
    Just i -> do
      let indices = map (`mod` Seq.length finalSet) [i + 1000, i + 2000, i + 3000]
      return $ sum $ map (fst . Seq.index finalSet) indices

solveHard :: FilePath -> IO Int64
solveHard fp = runStdoutLoggingT $ do
  input <- parseFile parseInput fp
  processInputHard input

As I said, this takes 10-15 seconds on my machine for the larger input. Optimization is probably possible. My idea was to store the indices in a segment tree, since this structure could allow for rapid bulk updates over a contiguous interval of items. But I'm not 100% sure if it works out.

Video

Coming eventually.

Advent of Code

James Bowen