R/makeMazeBinary.R

In Ziegelsteintom/rmazing: Algorithms for Different Kinds of Perfect Mazes

#' Binary Maze Algorithm
#'
#' Builds a maze via binary algorithm.
#'
#' @param height how heigh should the maze be
#' @param width how wide should the maze be
#' @param seed a particular seed for reproducible results
#' @param start which is the starting point of the algorithm
#' @param bias 0.5 is unbiased, 1 and 0 are totally biased
#'
#' @return a dataframe generated with the sidewinder algorithm
#' @export
#'
#' @examples
#' maze <- makeMazeBinary(width = 10, height = 10)

makeMazeBinary <- function(height = 10 , width = 10, seed, start = 1, bias = 0.5){

  if(!missing(seed)) set.seed(seed)

  # number of cells
  n <- height*width

  # Initialize maze
  maze <- cbind(N = rep(1,n),     # North
                E = rep(1,n),     # East
                S = rep(1,n),     # South
                W = rep(1,n),     # West
                vis = rep(0,n),    # Visited
                x = rep(1:width, height),   # x-Coordinate
                y = rep(1:height, each = width),  # y-Coordinate
                ind = 1:n)

  # Calculate Indices
  # Cells on the right
  ind_x <- maze[, "x"] == width
  # Last one should not be opened to the north
  ind_x[n] <- FALSE
  # This cells need to be opened on the south
  ind_s <- ind_x[c((n-width+1):n, 1:(n-width))]

  # Cells on the top
  ind_y <- maze[, "y"] == height
  # Last one should not be opened to the east
  ind_y[n] <- FALSE
  # This cells need to be opened on the west
  ind_w <- ind_y[c(n,1:(n-1))]

  # Kill Walls
  maze[ind_x, "N"] <- 0
  maze[ind_s, "S"] <- 0
  maze[ind_y, "E"] <- 0
  maze[ind_w, "W"] <- 0

  # Cells on the edge so I can select all cells not on the edge
  edge <- ind_x  | ind_y
  edge[n] <- TRUE

  # Calculation if N or E should be deleted
  cells <- (width - 1) * (height - 1)
  ind_n <- sample(c(0,1), size = cells, prob = c(bias, 1 - bias), replace = TRUE)
  ind_e <- 1 - ind_n
  ind_s <- !edge[c((n-width+1):n, 1:(n-width))]
  ind_w <- !edge[c(n,1:(n-1))]

  # Deletion of Walls
  maze[!edge, "N"] <- ind_n
  maze[ind_s, "S"] <- ind_n
  maze[!edge, "E"] <- ind_e
  maze[ind_w, "W"] <- ind_e


  return(structure(maze, class = "maze",
                   width = width,
                   height = height,
                   start = start))
}