R/makeMazeEller.R

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

#' Eller Maze Algorithm
#'
#' Builds a maze via the Eller algorithm.
#'
#' @param height how high should the maze be
#' @param width how wide should the maze be
#' @param seed a particular seed for reproducible results
#' @param start starting point of the algorithm, can be ommited for a random
#' starting point
#' @param p Probability of linking two cells in a row togehter
#' @param q Probability of linking two cells in different rows together
#'
#' @return a dataframe generated with the Eller algorithm
#' @export
#'
#' @examples makeMazeEller()

makeMazeEller<- function(height = 10 , width = 10, seed, start = NULL, p = 0.5, q = 1/3){

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

  # number of cells
  n <- height*width

  # not really needed
  if(is.null(start)){start <- sample(1:n, size = 1)}

  # 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)

  maze <- cbind(maze, set = 0)

  # Start in the top row and assign set nr
  maze[maze[, "y"] == height, "set"] <- 1:width

  # for all rows from the top but not the last one
  for(i in height:2){

    # Phase 1
    # for each cell check if the cell right to it has the same set nr
    # if not, randomly join them together (not the last one, which has no right
    # neighbout)

    for(k in 1:(width - 1)){

      # calculate list nr
      left_cell  <- list_nr(x = k, y = i, width = width)
      right_cell <- list_nr(x = k +1 , y = i, width = width)

      # Do they belong to diferent sets
      if(maze[left_cell, "set"] != maze[right_cell, "set"]){

        # draw a random number to decide if they should be linked
        if(sample(c(1,0), size = 1, prob = c(p, 1-p)) == 1){

          # kill walls
          # one way
          ww <- which_wall(left_cell, right_cell, height)
          maze[left_cell, ww] <- 0

          # the other way
          ww <- which_wall(right_cell, left_cell, height)
          maze[right_cell, ww] <- 0

          # Change set nr
          set_left  <- maze[left_cell , "set"]
          set_right <- maze[right_cell, "set"]
          maze[maze[, "set"] == set_right, "set"] <- set_left
        }
      }

    }

    # Phase 2 downwards linking
    cells_current_row <- which(maze[, "y"] == i)
    unique_sets <- unique(maze[cells_current_row, "set"])

    for(u in unique_sets){

      bool_right_set <- maze[cells_current_row,  "set"] == u
      # cells in the current row with the current set
      cells_set <- cells_current_row[bool_right_set]

      # one cell in the set in the current row
      if(length(cells_set) == 1){

        # kill walls
        # one way
        ww <- which_wall(cells_set, cells_set - width, height)
        maze[cells_set, ww] <- 0

        # the other way
        ww <- which_wall(cells_set[1] - width, cells_set, height)
        maze[cells_set - width, ww] <- 0

        maze[cells_set - width, "set"] <- u

      # more than one cell in the set
      } else {
        # shuffle them and the first one hast a 100% chance to link down
        # the others have a prob = q chance of linking down
        cells_set <- sample(cells_set)

        # kill walls
        # one way
        ww <- which_wall(cells_set[1], cells_set[1] - width, height)
        maze[cells_set[1], ww] <- 0

        # the other way
        ww <- which_wall(cells_set[1] - width, cells_set[1], height)
        maze[cells_set[1] - width, ww] <- 0

        maze[cells_set[1] - width, "set"] <- u

        # rest of the cells with prop q linking down
        for(c in cells_set[-1]){
          if(sample(c(1,0), size = 1, prob = c(q, 1-q))){

            ww <- which_wall(c, c - width, height)
            maze[c, ww] <- 0

            # the other way
            ww <- which_wall(c - width, c, height)
            maze[c - width, ww] <- 0

            maze[c - width, "set"] <- u
          }
        }
      }
    }

    # Phase 3
    # assign set nr to the next row
    # get the list nr of those cells with no set nr
    index_next_row <- which(maze[, "y"] == i-1)
    temp <- which(maze[index_next_row, "set"] == 0)
    index_no_set <- index_next_row[temp]

    # index_no_set could be numeric(0) butit does no harm?
    m <- max(maze[,"set"]) + 1
    maze[index_no_set, "set"] <- m:(m + length(index_no_set) - 1)
  }


  # take care of last row
  i <- 1
  for(k in 1:(width - 1)){
    # calculate list nr
    left_cell  <- list_nr(x = k, y = i, width = width)
    right_cell <- list_nr(x = k +1 , y = i, width = width)

    # Do they belong to diferent sets
    if(maze[left_cell, "set"] != maze[right_cell, "set"]){

      # kill walls
      # one way
      ww <- which_wall(left_cell, right_cell, height)
      maze[left_cell, ww] <- 0

      # the other way
      ww <- which_wall(right_cell, left_cell, height)
      maze[right_cell, ww] <- 0

      # Change set nr
      set_left  <- maze[left_cell , "set"]
      set_right <- maze[right_cell, "set"]
      maze[maze[, "set"] == set_right, "set"] <- set_left
    }
  }


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