R/solveMaze.R

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

#' Solve Maze
#'
#' Solves a maze given the maze and the distance matrix
#'
#' @param maze a maze object
#' @param dist a distance matrix
#'
#' @return a matrix with the solution which can pe ploted
#'
#' @export
#'
#' @examples
#' maze <- makeMazeBinary()
#' d <- distance(maze)
#' solveMaze(maze, d)

solveMaze <- function(maze, dist) {

  w <- attributes(maze)$width
  h <- attributes(maze)$height

  # solve Matrix initialisieren
  solve_mat <- matrix(0, nrow = h, ncol = w)

  # Startwert initialisieren
  k <- 1

  # start for backtracking
  solve_mat[1, w] <- k

  # distance bis zum Ziel
  distance <- dist[1,w]

  # end is distance is reached
  end <- dist[1,w]

  # Laueft rueckwaerts das Labyrinth entlang und nimmt immer den Weg Richtung
  # Ausgang
  while(k != end){

    ind <- which(solve_mat == k, arr.ind = TRUE)

    nr <- list_nr(ind[2], h + 1 -ind[1], width = w)

    nachb <- neighbour(nr, w, h, maze)
    nachb <- nachb[nachb!=0]
    for(i in nachb){

      #distance check
      distance_check <- dist[h + 1 -maze[i,"y"],maze[i,"x"]] == distance - 1
      #wall check
      wall_nr <- which_wall(nr,i, h)
      wall_check <- maze[nr, wall_nr] == 0

      if(distance_check & wall_check)

        solve_mat[h + 1 -maze[i,"y"],maze[i,"x"]] <- k + 1

    }

    k <- k + 1
    distance <- distance - 1

  }

  return(structure(solve_mat, class = "solution", width = w, height = h))
}