Day 9 - Knot Tracing

Dec 9

All 2022 Problems

Problem Overview

For this problem, we're tracking the movement of a rope with knots in it as it moves through a 2D grid. Our input is a series of "moves" (up/right/down/left) with numbers attached for the times we move in that direction. The move tells us how the "head" of the rope moves. The "tail" (or tails) follow the head in a particular fashion.

In the first part, we only have two knots. We move the head knot, and then one tail knot follows. In the second part, we have 10 total knots. Each tail knot follows the knot ahead of it. In each case, our final answer is the number of unique coordinates traveled by the final knot in the rope.

Parsing the Input

This is mostly a line-by-line parsing problem, but we'll have a slight change.

All we're parsing in the input is the list of moves, each with a direction character and a number of moves.

R 4
U 4
L 3
D 1
R 4
D 1
L 5
R 2

We'll start with a type to represent the moves:

data Move = UpMove | RightMove | DownMove | LeftMove
  deriving (Show)

Parsing one line into a list of moves is pretty easy. We'll replicate the move using the number.

type LineType = [Move]

parseLine :: (MonadLogger m) => ParsecT Void Text m LineType
parseLine = do
  move <- up <|> right <|> down <|> left
  char ' '
  i <- parsePositiveNumber
  return $ replicate i move
  where
    up = char 'U' >> return UpMove
    right = char 'R' >> return RightMove
    down = char 'D' >> return DownMove
    left = char 'L' >> return LeftMove

And to combine this, we'll just concat the lines together.

type InputType = [Move]

parseInput :: (MonadLogger m) => ParsecT Void Text m InputType
parseInput = concat <$> sepEndBy1 parseLine eol

Getting the Solution

There are basically three parts to this solution.

One function to move the head knot based on the move
One function to determine how a tail knot follows a head
Write a recursive loop function to move a whole list of knots to follow each other, and use this to fold over the moves.

The first function is an easy case statement.

nextHead :: Coord2 -> Move -> Coord2
nextHead (headX, headY) move = case move of
  UpMove -> (headX + 1, headY)
  RightMove -> (headX, headY + 1)
  DownMove -> (headX - 1, headY)
  LeftMove -> (headX, headY - 1)

Now for the knot-following logic. This has many cases. Note: the last 4 deal with the Cartesian Quadrants.

The tail is within 1 space (including diagonally) of the head. In this case the knot doesn't move.
Head and tail are in the same row. Tail moves one space horizontally towards the head.
Head and tail are in the same column. Tail moves one space vertically towards the head.
The head is in Quadrant 1 compared to the tail. Move tail up and right.
The head is in Quadrant 2. Move tail up and left..
The head is in Quadrant 3. Move tail down and left.
Otherwise (should be Quadrant 4), move tail down and right.

We can start with the "don't move" logic.

nextTail :: Coord2 -> Coord2 -> Coord2
nextTail head@(headX, headY) tail@(tailX, tailY) 
  | dontMove = tail
  ...
  where
    dontMove = abs (headX - tailX) <= 1 && abs (headY - tailY) <= 1
    ...

Next, consider the "same row" or "same column" logic. We need if-statements within these for the distinction of left/right or up/down.

nextTail :: Coord2 -> Coord2 -> Coord2
nextTail head@(headX, headY) tail@(tailX, tailY) 
  | dontMove = tail
  | headX == tailX = (tailX, if tailY < headY then tailY + 1 else tailY - 1)
  | headY == tailY = (if tailX > headX then tailX - 1 else tailX + 1, tailY)
  ...
  where
    dontMove = abs (headX - tailX) <= 1 && abs (headY - tailY) <= 1
    ...

And finally, we handle the quadrants.

nextTail :: Coord2 -> Coord2 -> Coord2
nextTail head@(headX, headY) tail@(tailX, tailY) 
  | dontMove = tail
  | headX == tailX = (tailX, if tailY < headY then tailY + 1 else tailY - 1)
  | headY == tailY = (if tailX > headX then tailX - 1 else tailX + 1, tailY)
  | q1 = (tailX + 1, tailY + 1)
  | q2 = (tailX + 1, tailY - 1)
  | q3 = (tailX - 1, tailY - 1)
  | otherwise = (tailX - 1, tailY + 1)
  where
    dontMove = abs (headX - tailX) <= 1 && abs (headY - tailY) <= 1
    q1 = headX > tailX && headY > tailY
    q2 = headX > tailX && headY < tailY
    q3 = headX < tailX && headY < tailY

Now for the final step. We'll fold through the moves, and keep an updated set of the coordinates where the tail has been, as well as the list of the knot locations. We'll parameterize by the number of knots.

type FoldType = (S.Set Coord2, [Coord2])

initialFoldV :: Int -> FoldType
initialFoldV n = (S.empty, replicate n (0, 0))

Now for the folding function itself. First let's handle an invalid case of empty knots.

foldMove :: (MonadLogger m) => FoldType -> Move -> m FoldType
foldMove (prevSet, knots) move = if null knots then logErrorN "Invalid case, empty knots list!" >> return (prevSet, knots)
  else do
    ...

Then we'll have a recursive helper within this function that will gradually accumulate the new knots from the old locations. So the first argument is the accumulator of new locations, and the second argument is the remaining knots to shift. So let's write the base case first.

foldMove :: (MonadLogger m) => FoldType -> Move -> m FoldType
foldMove (prevSet, knots) move = if null knots then logErrorN "Invalid case, empty knots list!" >> return (prevSet, knots)
  else do
    ...
  where
    hardFoldTail :: (MonadLogger m) => [Coord2] -> [Coord2] -> m [Coord2]
    hardFoldTail [] _ = logErrorN "Invalid case!" >> return []
    hardFoldTail done [] = return done
    ...

In the first case, we never expect the accumulated list to be empty, since we'll give it one to start. For the second case, we have no more remaining knots, so we return our list.

In the recursive case, we'll use our nextTail function based on the most recent knot in the first list. We'll add this new location to the front of the list and then recurse on the rest.

foldMove :: (MonadLogger m) => FoldType -> Move -> m FoldType
foldMove (prevSet, knots) move = ...
  where
    hardFoldTail :: (MonadLogger m) => [Coord2] -> [Coord2] -> m [Coord2]
    hardFoldTail [] _ = logErrorN "Invalid case!" >> return []
    hardFoldTail done [] = return done
    hardFoldTail done@(head : _) (next : rest) = hardFoldTail (nextTail head next : done) rest

Finally, we launch into this recursive call by first getting the nextHead of the top of the input list. Then we'll add the final knot's location to our accumulated set. Because we accumulated in reverse, this is currently on top of our resulting list. But then we'll reverse it when we return.

foldMove :: (MonadLogger m) => FoldType -> Move -> m FoldType
foldMove (prevSet, knots) move = if null knots then logErrorN "Invalid case, empty knots list!" >> return (prevSet, knots)
  else do
    newLocations <- hardFoldTail [nextHead (head knots) move] (tail knots)
    return (S.insert (head newLocations) prevSet, reverse newLocations)
  where
    hardFoldTail :: (MonadLogger m) => [Coord2] -> [Coord2] -> m [Coord2]
    hardFoldTail [] _ = logErrorN "Invalid case!" >> return []
    hardFoldTail done [] = return done
    hardFoldTail done@(head : _) (next : rest) = hardFoldTail (nextTail head next : done) rest

Answering the Question

Pulling the rest of this together is easy! We just use different parameters for the initial fold value in the easy and hard solution. (Admittedly, I did the first part a slightly different way before I knew what the second part was and refactored after).

processInputEasy :: (MonadLogger m) => InputType -> m EasySolutionType
processInputEasy inputs = do
  (finalSet, _) <- foldM foldMove (initialFoldV 2) inputs
  return $ S.size finalSet

processInputHard :: (MonadLogger m) => InputType -> m HardSolutionType
processInputHard inputs = do
  (finalSet, _) <- foldM foldMove (initialFoldV 10) inputs
  return $ S.size finalSet

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

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

And this will give us our answer!

Video

YouTube Link

Advent of Code

James Bowen