Maze Generation Algorithms (Part 2)

In the previous part of this series on maze generation, I explained how one can generate perfect mazes using the “recursive backtracking algorithm”. In this part, I will introduce two additional maze generating algorithms. The first is a randomized version of the “Kruskal algorithm” devoloped by Joseph Kuruskal. The second is a randomized version of the “Modified Dijkstra-Jarník-Prim (DJP) algorithm” (or simply “Prim’s algorithm”) discovered by Vojtěch Jarník and later re-discovered by Robert C. Prim and Edsger W. Dijkstra.

Kruskal’s algorithm

Unlike the recursive backtracking algorithm, the Kruskal algorithm doesn’t mark any cells as visited or unvisited. Instead, it assigns each cell a unique ID. The algorithm works as follows:

• Randomly select an edge (or a cell and one of its neighbors).
• If the two cells have different IDs (i.e., there is no path connecting them):
  • Remove the wall between the two cells.
  • Change the ID of the neighboring cell (and all other cells with that ID) to that of the first cell.
• Repeat until there is only one ID left.

# create maze (all walls) of size n
n <- 10
maze <- vector("list", 0)
for (i in 1:n) {
  for (j in 1:n) {
    cell <- list(
      i = i,
      j = j,
      id = paste(i, j, sep = ","),
      north = TRUE,
      east = TRUE,
      south = TRUE,
      west = TRUE)
    maze[[length(maze)+1]] <- cell
  }
}
rm(i,j,cell)

# function to show maze
showMaze <- function(maze) {
  
  # background
  par(mar = rep(1,4), bg = "burlywood4", bty = "n")
  plot(rep(0,n+1) ~ c(0:n), type = "l", asp = 1, 
       ylim = c(0,n), xlim = c(0,n),
       yaxt = "n", xaxt = "n",
       ylab = "", xlab = "")
  
  # walls
  for (idx in 1:n^2) {
    i <- maze[[idx]]$i
    j <- maze[[idx]]$j  
    if (maze[[idx]]$north) lines(rep(i,2) ~ c(j-1,j), col="white", lwd=4)
    if (maze[[idx]]$south) lines(rep(i-1,2) ~ c(j-1,j), col="white", lwd=4)
    if (maze[[idx]]$east) lines(c(i-1,i) ~ rep(j,2), col="white", lwd=4)
    if (maze[[idx]]$west) lines(c(i-1,i) ~ rep(j-1,2), col="white", lwd=4)
  }
  
}

# function to find a neighbor
findNeighbor <- function(idx) {
  
  # select cell at position "idx"
  cell <- maze[[idx]]
  
  # determine rows and columns of all cells in the maze
  rows <- sapply(maze, FUN = function(cell) cell$i)
  cols <- sapply(maze, FUN = function(cell) cell$j)
  
  # determine neighbors
  above <- which(rows == (cell$i + 1) & cols == cell$j)
  below <- which(rows == (cell$i - 1) & cols == cell$j)
  left <- which(cols == (cell$j - 1) & rows == cell$i)
  right <- which(cols == (cell$j + 1) & rows == cell$i)
  neighbors <- c(above, below, left, right)

  # return
  if (length(neighbors) == 0) {         # no neighbors
    return(NA)
  } else if (length(neighbors) == 1) {  # exactly one neighbor
    return(neighbors)
  } else {                              # multiple neighbors 
    return(sample(neighbors,1))       
  }
}

# function to remove walls
removeWalls <- function(maze, a, b) {
  
  # a over b
  if (maze[[a]]$i == maze[[b]]$i + 1 & maze[[a]]$j == maze[[b]]$j) {
    maze[[a]]$south <- FALSE
    maze[[b]]$north <- FALSE
  }
  
  # a under b
  if (maze[[a]]$i == maze[[b]]$i - 1 & maze[[a]]$j == maze[[b]]$j) {
    maze[[a]]$north <- FALSE
    maze[[b]]$south <- FALSE
  }
  
  # a left of b
  if (maze[[a]]$j == maze[[b]]$j - 1 & maze[[a]]$i == maze[[b]]$i) {
    maze[[a]]$east <- FALSE
    maze[[b]]$west <- FALSE
  }
  
  # a right of b
  if (maze[[a]]$j == maze[[b]]$j + 1 & maze[[a]]$i == maze[[b]]$i) {
    maze[[a]]$west <- FALSE
    maze[[b]]$east <- FALSE
  }
  
  # returns
  return(maze)
  
}

# function to retrieve IDs of all cells
getID <- function(maze) sapply(maze, FUN = function(cell) cell$id)

# setup
set.seed(1234)

# create maze using Kruskal's algorithm
while (length(unique(getID(maze))) > 1) {
  
  # select a random cell and find its neighbor
  current <- sample(1:n^2, 1)
  neighbor <- findNeighbor(current)
  
  # check if the IDs of the two cells are different
  # if so, remove the wall between them and make the ID of all cells on the 
  # "second side" of the wall equal to the ID of the cell on the "first side"
  id_1 <- maze[[current]]$id
  id_2 <- maze[[neighbor]]$id
  if (id_1 != id_2) {
    maze <- removeWalls(maze, current, neighbor)
    reset_id <- which(getID(maze) == id_2)
    for (idx in reset_id) maze[[idx]]$id <- id_1
  }
  
  # # visualize progress
  # showMaze(maze)
  # Sys.sleep(0.5)
}

# show final result
showMaze(maze)

The modified Dijkstra-Jarník-Prim (DJP) algorithm

The DJP algorithm distinguishes cells depending on their “state”. The algorithm starts by marking one cell as “in”. All other cells of the maze are marked as “out”. A third state called “frontier” describes cells that are next to one of the cells marked “in”. The algorithm works as follows:

• Randomly select one of the “frontier” cells.
• Carve into that cell from one of its neighbors marked “in”.
• Mark the cell as “in”.
• Determine which of its neighbors are currently “out” and mark those neighbors as “frontier”.
• Repeat until no cell is in the “frontier” state.

# create maze (all walls) of size n
n <- 10
maze <- vector("list", 0)
for (i in 1:n) {
  for (j in 1:n) {
    cell <- list(
      i = i,
      j = j,
      state = "out",
      north = TRUE,
      east = TRUE,
      south = TRUE,
      west = TRUE)
    maze[[length(maze)+1]] <- cell
  }
}
rm(i,j,cell)

# function to show maze
showMaze <- function(maze) {
  
  # background
  par(mar = rep(1,4), bg = "burlywood4", bty = "n")
  plot(rep(0,n+1) ~ c(0:n), type = "l", asp = 1, 
       ylim = c(0,n), xlim = c(0,n),
       yaxt = "n", xaxt = "n",
       ylab = "", xlab = "")
  
  # shade areas
  for (idx in 1:n^2) {
    i <- maze[[idx]]$i
    j <- maze[[idx]]$j
    if (maze[[idx]]$state == "in") rect(j-1, i-1, j, i, col = "deepskyblue3", lty = 0)
    if (maze[[idx]]$state == "frontier") rect(j-1, i-1, j, i, col = "orange", lty = 0)
  }
  
  # walls
  for (idx in 1:n^2) {
    i <- maze[[idx]]$i
    j <- maze[[idx]]$j  
    if (maze[[idx]]$north) lines(rep(i,2) ~ c(j-1,j), col="white", lwd=4)
    if (maze[[idx]]$south) lines(rep(i-1,2) ~ c(j-1,j), col="white", lwd=4)
    if (maze[[idx]]$east) lines(c(i-1,i) ~ rep(j,2), col="white", lwd=4)
    if (maze[[idx]]$west) lines(c(i-1,i) ~ rep(j-1,2), col="white", lwd=4)
  }
  
}

# function to find a neighbor
findNeighbors <- function(idx, type) {
  cell <- maze[[idx]]
  rows <- sapply(maze, FUN = function(cell) cell$i)
  cols <- sapply(maze, FUN = function(cell) cell$j)
  above <- which(rows == (cell$i + 1) & cols == cell$j)
  below <- which(rows == (cell$i - 1) & cols == cell$j)
  left <- which(cols == (cell$j - 1) & rows == cell$i)
  right <- which(cols == (cell$j + 1) & rows == cell$i)
  candidates <- c(above, below, left, right)
  states <- sapply(maze[candidates], FUN = function(cell) cell$state)
  if (type == "out") neighbors <- candidates[which(states == "out")]
  if (type == "in") neighbors <- candidates[which(states == "in")]
  if (length(neighbors) == 0) {
    return(NA)
  } else {
    return(neighbors)
  }
}

# function to remove walls
removeWalls <- function(maze, a, b) {
  
  # a over b
  if (maze[[a]]$i == maze[[b]]$i + 1 & maze[[a]]$j == maze[[b]]$j) {
    maze[[a]]$south <- FALSE
    maze[[b]]$north <- FALSE
  }
  
  # a under b
  if (maze[[a]]$i == maze[[b]]$i - 1 & maze[[a]]$j == maze[[b]]$j) {
    maze[[a]]$north <- FALSE
    maze[[b]]$south <- FALSE
  }
  
  # a left of b
  if (maze[[a]]$j == maze[[b]]$j - 1 & maze[[a]]$i == maze[[b]]$i) {
    maze[[a]]$east <- FALSE
    maze[[b]]$west <- FALSE
  }
  
  # a right of b
  if (maze[[a]]$j == maze[[b]]$j + 1 & maze[[a]]$i == maze[[b]]$i) {
    maze[[a]]$west <- FALSE
    maze[[b]]$east <- FALSE
  }
  
  # returns
  return(maze)
  
}

# setup
set.seed(1234)
current <- 1
maze[[current]]$state <- "in"
neighbors <- findNeighbors(current, "out") # find neighbors that are "out"
for (idx in neighbors) maze[[idx]]$state <- "frontier"
frontier <- which(sapply(maze, FUN = function(cell) cell$state) == "frontier")

# create maze using modified DJP algorithm
while (length(frontier) > 0) {
  
  # select a random frontier cell as new current cell and carve in
  current <- ifelse(length(frontier)==1, frontier, sample(frontier, 1))
  maze[[current]]$state <- "in"
  neighbors <- findNeighbors(current, "in")
  neighbor <- ifelse(length(neighbors)==1, neighbors, sample(neighbors, 1))
  maze <- removeWalls(maze, neighbor, current)
  
  # mark new frontier
  neighbors <- findNeighbors(current, "out") # find neighbors that are out
  if (!any(is.na(neighbors))) {
    for (idx in neighbors) maze[[idx]]$state <- "frontier"
  }
  frontier <- which(sapply(maze, FUN = function(cell) cell$state) == "frontier")

  # visualize progress
  showMaze(maze)
  if (length(current) > 0 ) {
    i <- maze[[current]]$i
    j <- maze[[current]]$j
    points(x = j - 0.5, i - 0.5, col = "maroon", pch = 16, cex = 2)
  }
  Sys.sleep(0.5)
}

# show final result
showMaze(maze)

# show final result
showMaze(maze)