/wakamoleguy

I'm still running a couple days behind, and so this grey Sunday I am tackling Day 9: Rope Bridge. We're asked to simulate the movement of a rope, where the tail of the rope follows along with the movements of the head.

The Ways Ropes Move

Unusually, today I didn't start with parsing! Instead, I jumped right into modeling the rules of motion. There are two that we care about: the head following steps directly from our input file, and the tail being lazily tugged along behind it.

-- Tugs the first argument towards the second argument
tug :: (Int, Int) -> (Int, Int) -> (Int, Int)
tug (x, y) (a, b)
  | isTouching = (x, y)
  | x < a && y < b = (x + 1, y + 1)
  | x > a && y > b = (x - 1, y - 1)
  | x < a && y > b = (x + 1, y - 1)
  | x > a && y < b = (x - 1, y + 1)
  | x < a = (x + 1, y)
  | x > a = (x - 1, y)
  | y < b = (x, y + 1)
  | y > b = (x, y - 1)
  | otherwise = (x, y)
  where
    isTouching = abs (x - a) <= 1 && abs (y - b) <= 1

data Direction = North | South | East | West deriving (Show, Eq)

step :: (Int, Int) -> Direction -> (Int, Int)
step (x, y) North = (x, y + 1)
step (x, y) South = (x, y - 1)
step (x, y) East = (x + 1, y)
step (x, y) West = (x - 1, y)

The tug function isn't pretty, but it works!

Parsing The Input

We have a list of commands in our input. Each line can represent several individual motions, but we really want to simulate them one by one. Let's expand them out.

strToDir :: Char -> Direction
strToDir 'U' = North
strToDir 'D' = South
strToDir 'R' = East
strToDir 'L' = West
strToDir c = error $ "Invalid direction: " ++ show c

input :: IO [Direction]
input = concatMap parseMotions . lines <$> readDay 2022 9
  where
    parseMotions (d : ' ' : n) = replicate (read n) (strToDir d)
    parseMotions _ = error "Invalid motion"

Simulating the Rope

How do we simulate the rope? Well, the head of the rope moves according to the direction, and the tail of the rope follows. I had a hunch (read: saw on Reddit) that Part 2 may involve a longer rope, so I structured it as a recursive function:

stepRope :: [(Int, Int)] -> Direction -> [(Int, Int)]
stepRope (h : t) dir = step h dir : follow (step h dir) t
  where
    follow prev (next : rest) = tug next prev : follow (tug next prev) rest
    follow _ [] = []

This pretty closely matches how we'd describe it in English, which is one thing I love about the expressiveness of Haskell.

Now we want to fold our list of steps over our rope to simulate its motion. But wait! We care about each state along the way, so instead of fold we use scan. Tracking the tail locations is as simple as getting the last item from each scan result, filtering to only unique coordinates, and counting them up.

part1 :: [Direction] -> Int
part1 = length . nub . fmap last . scanl stepRope [(0, 0), (0, 0)]

Part 2 is a longer rope, with 10 knots, but looks precisely the same:

part2 :: [Direction] -> Int
part2 = length . nub . fmap last . scanl stepRope (replicate 10 (0, 0))

Full Code

module AOC2022.Day09 (spec) where

import Data.List
import Input
import Test.Hspec

data Direction = North | South | East | West deriving (Show, Eq)

strToDir :: Char -> Direction
strToDir 'U' = North
strToDir 'D' = South
strToDir 'R' = East
strToDir 'L' = West
strToDir c = error $ "Invalid direction: " ++ show c

input :: IO [Direction]
input = concatMap parseMotions . lines <$> readDay 2022 9
  where
    parseMotions (d : ' ' : n) = replicate (read n) (strToDir d)
    parseMotions _ = error "Invalid motion"

spec :: IO ()
spec = hspec $ do
  describe "Day 9" $ do
    describe "Part 1" $ do
      it "runs on custom input" $ do
        myInput <- input
        stepRope [(1, 1), (0, 0)] North `shouldBe` [(1, 2), (1, 1)]
        part1 myInput `shouldBe` 0 -- redacted
    describe "Part 2" $ do
      it "runs on custom input" $ do
        myInput <- input
        part2 myInput `shouldBe` 0 -- redacted

-- Tugs the first argument towards the second argument
tug :: (Int, Int) -> (Int, Int) -> (Int, Int)
tug (x, y) (a, b)
  | isTouching = (x, y)
  | x < a && y < b = (x + 1, y + 1)
  | x > a && y > b = (x - 1, y - 1)
  | x < a && y > b = (x + 1, y - 1)
  | x > a && y < b = (x - 1, y + 1)
  | x < a = (x + 1, y)
  | x > a = (x - 1, y)
  | y < b = (x, y + 1)
  | y > b = (x, y - 1)
  | otherwise = (x, y)
  where
    isTouching = abs (x - a) <= 1 && abs (y - b) <= 1

step :: (Int, Int) -> Direction -> (Int, Int)
step (x, y) North = (x, y + 1)
step (x, y) South = (x, y - 1)
step (x, y) East = (x + 1, y)
step (x, y) West = (x - 1, y)

stepRope :: [(Int, Int)] -> Direction -> [(Int, Int)]
stepRope (h : t) dir = step h dir : follow (step h dir) t
  where
    follow prev (next : rest) = tug next prev : follow (tug next prev) rest
    follow _ [] = []
stepRope [] _ = []

part1 :: [Direction] -> Int
part1 = length . nub . fmap last . scanl stepRope [(0, 0), (0, 0)]

part2 :: [Direction] -> Int
part2 = length . nub . fmap last . scanl stepRope (replicate 10 (0, 0))

Advent of Code 2022 Series

This post is part of a series describing my Haskell solutions to Advent of Code 2022.

Next: Day 10: Cathode-Ray Tube Previous: Day 8: Treetop Tree House