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.
Subscribe to Monday Morning Haskell!
Problem Overview
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:
...#
.#..
#...
....
...#.......#
........#...
..#....#....
..........#.
...#....
.....#..
.#......
......#.
10R5L5R10L4R5L5First 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).
- Parse the cell lines (which adds padding to the front of each, remember).
- Get the maximum column and add padding to the back for each line. This includes one Blank beyond the final column for every row.
- Add an extra line of padding of 'Blank' to the top and bottom.
- 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.
- 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.
- Calculate "columnInfos" based on the maze grid. These tell us the first and last non-Blank index in each column.
- 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 -> FaceUpNow we'll calculate a single move, based on the location and direction.
- Get the next coordinate based on our direction
- If the next coordinate is empty, move there. If it's a wall, return the old location.
- 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:
- Get all maze indices that are empty in Row 1
- Sort by the column (snd)
- 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 resultPart 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) directionNote 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) resultThe 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.
