Generating More Difficult Mazes!

In the last part of this series, we established the fundamental structures for our maze game. But our "maze" was still rather bland. It didn't have any interior walls, so getting to the goal point was trivial. In this next part, we'll look at an algorithm for random maze generation. This will let us create some more interesting challenges. In upcoming parts of this series, we'll explore several more related topics. We'll see how to serialize our maze definition. We'll refactor some of our data structures. And we'll also take a look at another random generation algorithm.

If you've never programmed in Haskell before, you should download our Beginners Checklist! It will help you learn the basics of the language so that the concepts in this series will make more sense. The State monad will also see a bit of action in this part. So if you're not comfortable with monads yet, you should read our series on them!

Getting Started

We represent a maze with the type Map.Map Location CellBoundaries. For a refresher, a Location is an Int tuple. And the CellBoundaries type determines what borders a particular cell in each direction:

type Location = (Int, Int)

data BoundaryType = Wall | WorldBoundary | AdjacentCell Location

data CellBoundaries = CellBoundaries
  { upBoundary :: BoundaryType
  , rightBoundary :: BoundaryType
  , downBoundary :: BoundaryType
  , leftBoundary :: BoundaryType
  }

An important note is that a Location refers to the position in discrete x,y space. That is, the first index is the column (starting from 0) and the second index is the row. Don't confuse row-major and column-major ordering! (I did this when implementing this solution the first time).

To generate our maze, we'll want two inputs. The first will be a random number generator. This will help randomize our algorithm so we can keep generating new, fresh mazes. The second will be the desired size of our grid.

import System.Random (StdGen, randomR)

…

generateRandomMaze
  :: StdGen
  -> (Int, Int)
  -> Map.Map Location CellBoundaries
generateRandomMaze gen (numRows, numColumns) = ...

A Simple Randomization Algorithm

This week, we're going to use a relatively simple algorithm for generating our maze. We'll start by assuming everything is a wall, and we've selected some starting position. We'll use the following depth-first-search pattern:

1. Consider all cells around us
2. If there are any we haven't visited yet, choose one of them as the next cell.
3. "Break down" the wall between these cells, and put that new cell onto the top of our search stack, marking it as visited.
4. If we have visited all other cells around us, pop this current location from the stack
5. As long as there is another cell on the stack, choose it as the current location and continue searching from step 1.

There are several pieces of state we have to maintain throughout the process. So the State monad is an excellent candidate for this problem! Let's make a SearchState type for all these:

data SearchState = SearchState
  { randomGenerator :: StdGen
  , locationStack :: [Location]
  , currentBoundaries :: Map.Map Location CellBoundaries
  , visitedCells :: Set.Set Location
  }

dfsSearch :: State SearchState ()
dfsSearch = ...

Each time we make a random selection, we'll use the randomR function that returns the appropriate value as well as a new generator. Then we'll use a normal list for our search stack since we can push and pop from the top with ease. Next, we'll track the current state of the maze (it starts as all walls and we'll gradually break those down). Finally, there's the set of all cells we've already visited.

Starting Our Search!

To start our search process, we'll pull all our information out of the state monad, and examine the stack. If it's empty, we're done and can return! Otherwise, we'll want to consider the top location:

dfsSearch = do
  (SearchState gen locs bounds visited) <- get
  case locs of
    [] -> return ()
    (currentLoc : rest) -> do
      ...

Finding New Search Candidates

Given a particular location, we need to find the potential neighbors. We want to satisfy two conditions:

1. It shouldn't be in our visited set.
2. The boundary to this location should be a Wall

Then we'll want to use these properties to determine a list of candidates. Each candidate will contain 4 items:

1. The next location
2. The bounds we would use for the new location
3. The previous location
4. The new bounds for the previous location.

This seems like a lot, but it'll make more sense as we fill out our algorithm. With that in mind, here's the structure of our findCandidates function:

findCandidates
  :: Location -- Current location
  -> Map.Map Location CellBoundaries -- Current maze state
  -> Set.Set Location -- Visited Cells
  -> [(Location, CellBoundaries, Location, CellBoundaries)]
findCandidates currentLocation bounds visited = ...

Filling in this function consists of following the same process for each of the four directions from our starting point. First we check if the adjacent cell in that direction is valid. Then we create the candidate, containing the locations and their new boundaries. Since the location could be invalid, the result is a Maybe. Here's what we do for the "up" direction:

findCandidates =
  let currentLocBounds = fromJust $
        Map.lookup currentLocation bounds
      upLoc = (x, y + 1)
      maybeUpCandidate = case
        (upBoundary currentLocBounds, Set.member upLoc visited) of
        (Wall, False) -> Just
          ( upLoc
          , (fromJust $ Map.lookup upLoc bounds)
              { downBoundary = AdjacentCell currentLocation }
          , currentLocation
          , currentLocBounds { upBoundary = AdjacentCell upLoc }
          )
        ...

We replace the existing Wall elements with AdjacentCell elements in our maze map. This may seem like it's doing a lot of unnecessary work in calculating bounds that we'll never use. But remember that Haskell is lazy! Any candidate that isn't chosen by our random algorithm won't be fully evaluated. We repeat this process for each direction and then use catMaybes on them all:

findCandidates =
  let currentLocBounds = fromJust $ Map.lookup currentLocation bounds
      upLoc = (x, y + 1)
      maybeUpCandidate = …
      rightLoc = (x + 1, y)
      maybeRightCandidate = …
      downLoc = (x, y - 1)
      maybeDownCandidate = …
      leftLoc = (x - 1, y)
      maybeLeftCandidate = …
  in  catMaybes [maybeUpCandidate, maybeRightCandidate, … ]

Choosing A Candidate

Our search function is starting to come together now. Here's what we've got so far. If we don't have any candidates, we'll reset our search state by popping the current location off our stack. Then we can continue the search by making another call to dfsSearch.

dfsSearch = do
  (SearchState gen locs bounds visited) <- get
  case locs of
    [] -> return ()
    (currentLoc : rest) -> do
      let candidateLocs = findCandidates currentLoc bounds visited
      if null candidateLocs
        then put (SearchState gen rest bounds visited) >> dfsSearch
        else ...

But assuming we have a non-empty list of candidates, we'll need to choose one. This function will update most of our state elements, so we'll put in in the State monad as well:

chooseCandidate
  :: [(Location, CellBoundaries, Location, CellBoundaries)]
  -> State SearchState ()
chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  ...

First, we'll need to select a random index into this list, which assumes it is non-empty.:

chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  let (randomIndex, newGen) = randomR (0, (length candidates) - 1) gen
      (chosenLocation, newChosenBounds, prevLocation, newPrevBounds) =
        candidates !! randomIndex

Since we did the hard work of creating the new bounds objects up above, the rest is straightforward. We'll create our new state with different components.

We get a new random generator from the randomR call. Then we can push the new location onto our search stack. Next, we update the bounds map with the new locations. Last, we can add the new location to our visited array:

chooseCandidate candidates = do
  (SearchState gen currentLocs boundsMap visited) <- get
  let (randomIndex, newGen) = randomR (0, (length candidates) - 1) gen
      (chosenLocation, newChosenBounds, prevLocation, newPrevBounds) =
        candidates !! randomIndex
      newBounds = Map.insert prevLocation newPrevBounds
        (Map.insert chosenLocation newChosenBounds boundsMap)
      newVisited = Set.insert chosenLocation visited
      newSearchStack = chosenLocation : currentLocs
  put (SearchState newGen newSearchStack newBounds newVisited)

Then to wrap up our DFS, we'll call this function at the very end. Remember to make the recursive call to dfsSearch!

dfsSearch = do
  (SearchState gen locs bounds visited) <- get
  case locs of
    [] -> return ()
    (currentLoc : rest) -> do
      let candidateLocs = findCandidates currentLoc bounds visited
      if null candidateLocs
        then put (SearchState gen rest bounds visited) >> dfsSearch
        else (chooseCandidate candidateLocs) >> dfsSearch

Incorporating Our Search

As a last step in our process, we need to incorporate our search function. At the most basic level, we'll want to execute our DFS state function and extract the boundaries from it:

generateRandomMaze :: StdGen -> (Int, Int) -> Map.Map Location CellBoundaries
generateRandomMaze gen (numRows, numColumns) =
  currentBoundaries (execState dfsSearch initialState)
  where
    initialState :: SearchState
    initialState = ...

But we need to build our initial state. We'll start our search from a random location. Our initial stack and visited set will contain this location. Notice that with each random call, we use a new generator.

generateRandomMaze gen (numRows, numColumns) =
  currentBoundaries (execState dfsSearch initialState)
  where
    (startX, g1) = randomR (0, numColumns - 1) gen
    (startY, g2) = randomR (0, numRows - 1) g1

    initialState :: SearchState
    initialState = SearchState
      g2
      [(startX, startY)]
      … -- TODO Bounds
      (Set.fromList [(startX, startY)])

The last thing we need is our initial bounds set. For this, I'm going to tease the next part of the series. We'll write a function to parse a maze from a string representation (and reverse the process). Our encoding will represent a "surrounded" cell with the character 'F'. So we can represent a completely blocked maze like so:

generateRandomMaze gen (numRows, numCols) = …
  where
    …

    fullString :: Text
    fullString = pack . unlines $
      take numRows $ repeat (take numColumns (repeat 'F'))

Finally, we'll apply the mazeParser function in Megaparsec style. You'll have to wait a couple weeks to see how to implement that! It will give us the appropriate cell boundaries.

generateRandomMaze gen (numRows, numColumns) =
  currentBoundaries (execState dfsSearch initialState)
  where
    (startX, g1) = randomR (0, numColumns - 1) gen
    (startY, g2) = randomR (0, numRows - 1) g1

    initialState :: SearchState
    initialState = SearchState
      g2
      [(startX, startY)]
      initialBounds
      (Set.fromList [(startX, startY)])

    initialBounds :: Map.Map Location CellBoundaries
    initialBounds = case Megaparsec.runParser
      (mazeParser (numRows, numColumns) "" fullString of
        Right bounds -> bounds
        _ -> error "Couldn't parse maze for some reason!"

    fullString :: Text
    fullString = ...

You can also look at our Github repo for some details. You'll want the part-2 branch if you want more details about how everything works!

Conclusion

Generating random mazes is cool. But it would be nice if we could actually finish the maze we're running and do another one! Next week, we'll make some modifications to the game state so that when we finish with one maze, we'll have the option to try another random one!

If you're just getting started with Haskell, we have some great resources to get you going! Download our Beginners Checklist and read our Liftoff Series!