R/auxFunctions.R

In pablorm296/msweepeR: A Text Based Minesweeper Game for R (and Geeky R Users)

#' Function to reveal msBoard tiles
#'
#' This function implements a recursive version of the Flood Fill algorithm in the \code{x_mask} matrix.
#' It starts at the specified \code{x_mask[row,col]} coordinates and tries to fill the 8 neighbouring matrix elements
#' with a 1 when such elements (both in \code{x_mask} and \code{x_real} matrices) are 0. This function is mainly used to
#' update a \code{msBoard} object in a \code{\link{msweepeR}} session.
#' @param x_real A matrix.
#' @param x_mask A matrix. Must be of same width and length as \code{x_real}.
#' @param row A positive integer indicating the row number where the Flood Fill will start.
#' @param col A positive integer indicating the col number where the Flood Fill will start.
#' @return This function returns an updated (flooded) version of the matrix \code{x_mask}.
#' @seealso \code{\link{msweepeR}}, \code{\link{msBoard}}
#' @export
revealTile <- function(x_real, x_mask, row, col) {
  x_mask[row, col] <- 1
  w <- ncol(x_real)
  h <- nrow(x_real)
  #Definir coordenadas de las 8 baldosas al rededor
  tile_no <- c(row - 1, col - 1)
  tile_n <- c(row - 1, col)
  tile_ne <- c(row - 1, col + 1)
  tile_o <- c(row, col - 1)
  tile_e <- c(row, col + 1)
  tile_so <- c(row + 1, col - 1)
  tile_s <- c(row + 1, col)
  tile_se <- c(row + 1, col + 1)
  #Ponerlas en una lista
  tiles_coordinates <- list(tile_no, tile_n, tile_ne,
                            tile_o, tile_e,
                            tile_so, tile_s, tile_se)
  #Iterar por cada una de las 8 baldosas al rededor
  for (tile in tiles_coordinates) {
    #Baldosa inválida
    if (tile[1] < 1 | tile[1] > h | tile[2] < 1 | tile[2] > w ) {
      next()
    }
    #Si hay mina, saltar a la siguiente iteracion
    if (x_real[tile[1], tile[2]] == 1) {
      next()
    }
    #Si ya está revelada o hay una bandera, saltar a la siguiente iteración
    if (x_mask[tile[1], tile[2]] == 1 | x_mask[tile[1], tile[2]] == 2) {
      next()
    #Si no está revelado y no hay una mina
    } else if (x_mask[tile[1], tile[2]] == 0) {
      x_mask[tile[1], tile[2]] <- 1
      return(revealTile(x_real, x_mask, tile[1], tile[2]))
    }
  }
  return(x_mask)
}

#' Function to parse user instructions
#'
#' This function parses the \code{\link{msweepeR}} game command supplied by the user.
#' This function is mainly used to update a \code{msBoard} object during a \code{\link{msweepeR}}
#' game session.
#' @param command A character vector of length 1 containing the \code{\link{msweepeR}} game command supplied by the user
#' during a \code{\link{msweepeR}} game session.
#' @return This function returns a numeric vector of length < 5 containing a syntax representation of the command.
#' The first element is a header that indicates whether an error ocurred while parsing the code. The second element, if no
#' error ocurred, indicates the desired action to be applied on the \code{msBoard} (open a tile or put a flag), and finally
#' the third and fourth elements (again, if no error ocurred while parsing) represent the tile coordinates where the action
#' should take place. However, if there's an error header, the remaining elements of the vector contains information about the
#' error.
#' @seealso \code{\link{msweepeR}}, \code{\link{msBoard}}, \code{\link{eval_msweepeR_cmd}}
#' @export
parse_msweepeR_cmd <- function(command) {
  #Objeto de retorno
  #[1] = 1 = ok
  #[1] = -1 = error

  #Verificar si es cadena de caracteres
  if (!is.character(command)) return(c(-1, 1)) #Error: a valid command must be a non-empty character object

  #Convertir en minúsculas
  command <- tolower(command)

  #Eliminar espacios en blanco
  command <- gsub(" ", "", command, fixed = T)

  #Verificar que comando no esté vacío
  if (nchar(command) <= 0) return(c(-1, 1)) #Error: a valid command must be a non-empty character object

  #Dividir comando a partir de @
  splitted_command <- strsplit(command, split = "@", fixed = T)[[1]]

  #El comando ahora debe tener una longitud de dos
  #Si es de 1, sólo puede ser exit
  if (length(splitted_command) == 1) {
    if (splitted_command == "exit") {
      #Ok: exit
      return(c(1, 0))
    } else {
      if (grepl(pattern = "@", x = command, fixed = T)) {
        #Error: empty tiles coordinates
        return(c(-1, 6))
      } else {
        #Error: unexpected symbol 'splitted_command'
        return(c(-1, 4, splitted_command))
      }
    }
  } else if (length(splitted_command) > 2 | length(splitted_command) < 1) {
    #Error: syntax error
    return(c(-1, 3))
  } else if (length(splitted_command) == 2) {
    #Si el primer comando es open o flag
    if (splitted_command[1] == "open" | splitted_command[1] == "flag") {
      if (splitted_command[1] == "open") {
        #Dividir segunda parte con la coma
        splitted_coordinates <- strsplit(x = splitted_command[2], split = ",", fixed = T)[[1]]
        #Verificar longitud de la segunda parte
        if (length(splitted_coordinates) != 2) {
          #Error: invalid tile coordinates 'coordinates'
          return(c(-1, 5, splitted_command[2]))
        } else {
          splitted_coordinates <- as.integer(splitted_coordinates)
          if (!is.na(splitted_coordinates[1]) & !is.na(splitted_coordinates[2])) {
            #Ok: 1, 1, coordinates
            return(c(1, 1, splitted_coordinates[1], splitted_coordinates[2]))
          } else {
            #Error: invalid tile coordinates 'coordinates'
            return(c(-1, 5, splitted_command[2]))
          }
        }
      } else {
        #Dividir segunda parte con la coma
        splitted_coordinates <- strsplit(x = splitted_command[2], split = ",", fixed = T)[[1]]
        #Verificar longitud de la segunda parte
        if (length(splitted_coordinates) != 2) {
          #Error: invalid tile coordinates 'coordinates'
          return(c(-1, 5, splitted_command[2]))
        } else {
          splitted_coordinates <- as.integer(splitted_coordinates)
          if (!is.na(splitted_coordinates[1]) & !is.na(splitted_coordinates[2])) {
            #Ok: 1, 2, coordinates
            return(c(1, 2, splitted_coordinates[1], splitted_coordinates[2]))
          } else {
            #Error: invalid tile coordinates 'coordinates'
            return(c(-1, 5, splitted_command[2]))
          }
        }
      }
    } else {
      #Error: unexpected symbol 'command'
      return(c(-1, 4, splitted_command[1]))
    }

  }

}

#' Function to evaluate user instructions
#'
#' This function evaluates the syntax vector parsed from a \code{\link{msweepeR}} game command supplied by the user.
#' This function is mainly used to update a \code{msBoard} object during a \code{\link{msweepeR}}
#' game session.
#' @param syntax_vector A numeric vector generated from \code{\link{parse_msweepeR_cmd}}.
#' @return This function returns a mixed vector, that can be passed to \code{\link{change.msBoard}}.
#' @seealso \code{\link{msweepeR}}, \code{\link{msBoard}}, \code{\link{eval_msweepeR_cmd}}
#' @export
eval_msweepeR_cmd <- function(syntax_vector) {
  if (syntax_vector[1] == -1) {
    if (syntax_vector[2] == 1) {
      cat("Error: a valid command must be a non-empty character object\n", sep = "")
    } else if (syntax_vector[2] == 2) {
      stop("Unassigned error code")
    } else if (syntax_vector[2] == 3) {
      cat("Error: invalid syntax\n")
    } else if (syntax_vector[2] == 4) {
      cat("Error: unexpected symbol '", syntax_vector[3], "'\n", sep = "")
    } else if (syntax_vector[2] == 5) {
      cat("Error: invalid tile coordinates '", syntax_vector[3], "'\n", sep = "")
    } else if (syntax_vector[2] == 6) {
      cat("Error: empty tile coordinates\n", sep = "")
    } else {
      stop("Unassigned error code")
    }
    return("error")
  } else if (syntax_vector[1] == 1) {
    if (syntax_vector[2] == 1) {
      return(c("open", syntax_vector[3], syntax_vector[4]) )
    } else if (syntax_vector[2] == 2) {
      return(c("flag", syntax_vector[3], syntax_vector[4]) )
    } else if (syntax_vector[2] == 0) {
      return("end")
    } else {
      stop("Unassigned action code")
    }
  } else {
   stop("Unknown response code")
  }

}


#' Function to update and save R history
#'
#' This function saves a custom text line into R's history file. It's mainly used to
#' save the user's last game instructions after updating a \code{msBoard} object during a \code{\link{msweepeR}}
#' game session.
#'
#' @param line A character vector of length 1.
#' @seealso \code{\link{msweepeR}}, \code{\link{change.msBoard}}, \code{\link{play.msweepeR}}
#' @import utils
#' @export
update_history <- function(line) {
  savehistory()
  line <- paste(line, "\n", sep = "")
  write(line, file = ".Rhistory", append = TRUE)
  loadhistory()
}