Day 22 - Cube Maze

Not necessarily the most challenging in terms of algorithms or performance. But this problem required a tremendous amount of intricacy with processing each move through a maze. Dozens of places to make off-by-one errors or basic arithmetic issues.

With so many details, this article will give a higher level outline, but the code on GitHub is extensively commented to show what's happening, so you can use that as a guide as well.

Solution code on GitHub

All 2022 Problems

Subscribe to Monday Morning Haskell!

Problem Overview

Full Description

We're given an irregularly shaped maze. Most positions are empty but some are walls. Here's an example:

...#
        .#..
        #...
        ....
...#.......#
........#...
..#....#....
..........#.
        ...#....
        .....#..
        .#......
        ......#.

We're going to navigate this maze based on a series of instructions where we turn (right or left) and then move a certain distance.

In part 1, whenever we go off the end of the grid, we wrap back around to the opposite end of the maze in the direction we're going.

But in part 2, we imagine that the maze is folded up into a cube with six sides! We still retain the same 2D coordinate system, but the logic for what happens when we wrap is a lot more challenging.

Solution Approach and Insights

The key insight I had for the first part was to make a 2D grid where spaces not in the maze are marked as Blank. I also added a padding layer of Blank spaces around the edge. This made it easy to determine when I needed to wrap. Then I kept track of the non-blank indices in each row and column to help with calculating where to go.

In part 2, I basically hard-coded the structure of the cube to determine the wrapping rules (and the structures were different for the example input and the large input). This was quite tedious, but allowed me to keep the overall structure of my code.

Parsing the Input

First, some simple types for directions and turning:

data Direction =
  FaceUp |
  FaceDown |
  FaceLeft |
  FaceRight
  deriving (Show, Eq)

data Turn = TurnLeft | TurnRight
  deriving (Show, Eq)

Now for the "cells" in our grid. We have empty spaces that are actually part of the maze (.), walls in the maze (#), and "blank" spaces that are not part of the grid but fall within its 2D bounds.

data Cell =
  Empty |
  Wall |
  Blank
  deriving (Show, Eq)

Now for parsing. Here's the full example input:

...#
        .#..
        #...
        ....
...#.......#
........#...
..#....#....
..........#.
        ...#....
        .....#..
        .#......
        ......#.

10R5L5R10L4R5L5

First parse a single line of maze input. In addition to the list of cells, this also returns the start and end column of the non-blank spaces. Note: this function adds an extra 'Blank' to the front of the row because we want to pad all 4 directions.

type LineType = ([Cell], (Int, Int))
parseLine :: (MonadLogger m, MonadFail m) => ParsecT Void Text m LineType
parseLine = do
  cells <- some parseCell
  let frontPadded = Blank : cells
  case findIndex (/= Blank) frontPadded of
    Nothing -> fail "A line is completely blank!"
    Just i -> do
      return (frontPadded, (i, length frontPadded - 1))
  where
    parseCell = (char ' ' >> return Blank) <|> (char '.' >> return Empty) <|> (char '#' >> return Wall)

Let's also have a function to parse the directions. This function is recursive. It runs until we encounter 'eof'.

parsePath :: (MonadLogger m, MonadFail m) => [(Turn, Int)] -> ParsecT Void Text m [(Turn, Int)]
parsePath accum = finished <|> notFinished
  where
    finished = eof >> return (reverse accum) {- Base Case: End-of--File -}
    notFinished = do
      t <- (char 'R' >> return TurnRight) <|> (char 'L' >> return TurnLeft)
      i <- parsePositiveNumber
      parsePath ((t, i) : accum) {- Recursive Case: Add the new turn and distance. -}

Now we'll put it all together. This is a fairly intricate process (7 steps).

  1. Parse the cell lines (which adds padding to the front of each, remember).
  2. Get the maximum column and add padding to the back for each line. This includes one Blank beyond the final column for every row.
  3. Add an extra line of padding of 'Blank' to the top and bottom.
  4. Construct a 2D Array with the cells. The first element that can be in the maze is (1,1), but Array's index starts at (0,0) for padding.
  5. Make an array out of "rowInfos", which are included from parsing the rows. These tell us the first and last non-Blank index in each row.
  6. Calculate "columnInfos" based on the maze grid. These tell us the first and last non-Blank index in each column.
  7. Parse the path/directions.
type MazeInfo = (Grid2 Cell, A.Array Int (Int, Int), A.Array Int (Int, Int))
type InputType = (MazeInfo, [(Turn, Int)])

parseInput :: (MonadLogger m, MonadFail m) => ParsecT Void Text m InputType
parseInput = do
  {- 1 -}
  cellLines <- sepEndBy1 parseLine eol
  let maxColumn = maximum (snd . snd <$> cellLines)
{-2-} paddedCellLines = map (\(cells, (_, lastNonBlankIndex)) -> cells ++ replicate (maxColumn - lastNonBlankIndex + 1) Blank) cellLines
{-3-} topBottom = replicate (maxColumn + 2) Blank
      finalCells = concat (topBottom : paddedCellLines) ++ topBottom
{-4-} maze = A.listArray ((0, 0), (length paddedCellLines + 1, maxColumn + 1)) finalCells
{-5-} rowInfos = A.listArray (1, length cellLines) (snd <$> cellLines)
{-6-} columns = map (calculateColInfo maze) [1..maxColumn]
      columnInfos = A.listArray (1, maxColumn) columns
  eol
  {-7-}
  firstLength <- parsePositiveNumber
  path <- parsePath [(TurnRight, firstLength)]
  return ((maze, rowInfos, columnInfos), path)
  where
    {- 6 -}
    calculateColInfo :: Grid2 Cell -> Int -> (Int, Int)
    calculateColInfo maze col =
      let nonBlankAssocs = filter (\((r, c), cell) -> c == col && cell /= Blank) (A.assocs maze)
          sorted = sort $ fst . fst <$> nonBlankAssocs
      in  (head sorted, last sorted)

Part 1

We start with a simple function for changing our direction based on turning:

turn :: Turn -> Direction -> Direction
turn TurnLeft d = case d of
  FaceUp -> FaceLeft
  FaceRight -> FaceUp
  FaceDown -> FaceRight
  FaceLeft -> FaceDown
turn TurnRight d = case d of
  FaceUp -> FaceRight
  FaceRight -> FaceDown
  FaceDown -> FaceLeft
  FaceLeft -> FaceUp

Now we'll calculate a single move, based on the location and direction.

  1. Get the next coordinate based on our direction
  2. If the next coordinate is empty, move there. If it's a wall, return the old location.
  3. If it's blank, wrap around to the next cell.

This last step requires checking the rowInfo for horizontal wrapping, and the columnInfo for vertical wrapping.

move :: (MonadLogger m) => MazeInfo -> (Coord2, Direction) -> m Coord2
move (maze, rowInfo, columnInfo) (loc@(row, column), direction) = return nextCell
  where
    {- 1 -}
    nextCoords = case direction of
      FaceUp -> (row - 1, column)
      FaceRight -> (row, column + 1)
      FaceDown -> (row + 1, column)
      FaceLeft -> (row, column - 1)
    nextCell = case maze A.! nextCoords of
      Wall -> loc {- 2 -}
      Empty -> nextCoords {- 2 -}
      Blank -> if maze A.! nextCellWrapped == Empty
        then nextCellWrapped
        else loc

    {- 3 -}
    nextCellWrapped = case direction of
      FaceUp -> (snd $ columnInfo A.! column, column)
      FaceRight -> (row, fst $ rowInfo A.! row)
      FaceDown -> (fst $ columnInfo A.! column, column)
      FaceLeft -> (row, snd $ rowInfo A.! row)

Now we can run all the moves. This requires two layers of recursion. In the outer layer, we process a single combination of turn/distance. In the inner layer we run a single move, recursing n times based on the distance given in the directions. For part 1, we only need to calculate the new direction once.

-- Recursively run all the moves.
-- With each call, process one element of 'directions' - turn once and move the set number of times.
runMoves :: (MonadLogger m) => MazeInfo -> (Coord2, Direction) -> [(Turn, Int)] -> m (Coord2, Direction)
runMoves _ final [] = return final {- Base Case - No more turns/moves. -}
runMoves info (currentLoc, currentDir) ((nextTurn, distance) : rest) = do
  finalCoord <- runMovesTail distance currentLoc
  runMoves info (finalCoord, newDir) rest {- Recursive -}
  where
    newDir = turn nextTurn currentDir

    -- Recursively move the given direction a set number of times.
    runMovesTail :: (MonadLogger m) => Int -> Coord2 -> m Coord2
    runMovesTail 0 c = return c {- Base Case - n=0 -}
    runMovesTail n c = do
      result <- move info (c, newDir)
      runMovesTail (n - 1) result {- Recursive Case (n - 1) -}

Now to call this function the first time, we just need to calculate the start, which is a 3-step process:

  1. Get all maze indices that are empty in Row 1
  2. Sort by the column (snd)
  3. Pick the first
processInputEasy :: (MonadLogger m) => (MazeInfo, [(Turn, Int)]) -> m EasySolutionType
processInputEasy (info@(maze, _, _), directions) = runMoves info (start, FaceUp) directions
  where
    -- The initial position in the maze
    start :: Coord2
    start = head $ {-3-}
{-2-} sortOn snd $
{-1-} filter (\c@(row, _) -> row == 1 && maze A.! c == Empty) (A.indices maze)

A noteworthy item is that we give the initial direction FaceUp, because the problem tells us to assume we are facing right initially, and we added a Right turn to the start of our turns list in order to resolve the mismatch between directions and distances in the input.

And now we tie the answer together:

solveEasy :: FilePath -> IO (Maybe Int)
solveEasy fp = runStdoutLoggingT $ do
  input@((grid, rowInfos, columnInfos), turns) <- parseFile parseInput fp
  result <- processInputEasy input
  findEasySolution result

Part 2

Most of the heavy-lifting for Part 2 is done by some serious hard-coding of the (literally) edge cases where we travel from one edge of the cube to another. You can observe these functions here but I won't bother copying them here. Unfortunately, the small input and large input require different functions.

These get abstracted into a new MazeInfoHard typedef and a WrapFunction description:

type Face = Int
type MazeInfoHard = (Grid2 Cell, Coord2 -> Face)
type WrapFunction = Coord2 -> Face -> Direction -> (Coord2, Direction)

The move function looks basically the same as part 1, but the wrapping logic is abstracted out.

moveHard :: (MonadLogger m) => MazeInfoHard -> WrapFunction -> (Coord2, Direction) -> m (Coord2, Direction)
moveHard (maze, getFace) wrap (loc@(row, column), direction) = return result
  where
    nextCoords = case direction of
      FaceUp -> (row - 1, column)
      FaceRight -> (row, column + 1)
      FaceDown -> (row + 1, column)
      FaceLeft -> (row, column - 1)
    result = case maze A.! nextCoords of
      Wall -> (loc, direction)
      Empty -> (nextCoords, direction)
      Blank -> if maze A.! nextCellWrapped == Empty
        then (nextCellWrapped, nextDirWrapped)
        else (loc, direction)

    {- Primary difference comes with this logic, see functions below. -}
    (nextCellWrapped, nextDirWrapped) = wrap loc (getFace loc) direction

Note that we can now change direction when we move, which wasn't possible before. This is also apparent looking at the new function for processing all the directions. It also has the same structure as before (nested recursion), but the direction must also change in the inner function.

runMovesHard :: (MonadLogger m) => MazeInfoHard -> WrapFunction -> (Coord2, Direction) -> [(Turn, Int)] -> m (Coord2, Direction)
runMovesHard _ _ final [] = return final
runMovesHard info wrap (currentLoc, currentDir) ((nextTurn, distance) : rest) = do
  (finalCoord, finalDir) <- runMovesTail distance (currentLoc, newDir)
  runMovesHard info wrap (finalCoord, finalDir) rest
  where
    newDir = turn nextTurn currentDir

    -- Unlike part 1, our direction can change without us "turning", so this function
    -- needs to return a new coordinate and a new direction.
    runMovesTail :: (MonadLogger m) => Int -> (Coord2, Direction) -> m (Coord2, Direction)
    runMovesTail 0 c = return c
    runMovesTail n (c, d) = do
      result <- moveHard info wrap (c, d)
      runMovesTail (n - 1) result

The upper processing function is virtually identical:

processInputHard :: (MonadLogger m) => (MazeInfoHard, [(Turn, Int)]) -> WrapFunction -> m EasySolutionType
processInputHard (mazeInfoHard@(maze, _), directions) wrap = runMovesHard mazeInfoHard wrap (start, FaceUp) directions
  where
    start = fst $ head $ sortOn (snd . fst) $ filter (\((row, _), cell) -> row == 1 && cell == Empty) (A.assocs maze)

And our outer most wrapper must now parameterize based on the "size" (small or large) to use the different functions:

solveHard :: String -> FilePath -> IO (Maybe Int)
solveHard size fp = runStdoutLoggingT $ do
  input@((grid, _, _), turns) <- parseFile parseInput fp
  -- This problem requires hardcoding between small and large solutions.
  let (wrapFunc, faceFunc) = if size == "small" then (wrapEasy, getFaceEasy) else (wrapHard, getFaceHard)
  result <- processInputHard ((grid, faceFunc), turns) wrapFunc
  findEasySolution result -- < Evaluation solution is same as in the "Easy" part.

This was a rather exhausting solution to write, mainly from all the arithmetic on the wrapping cases. But it's done! 3 more days to go!

Video

Coming eventually.

Previous
Previous

Day 23 - Spreading Out the Elves

Next
Next

Day 21 - Variable Tree Solving