R/bayesX.R

In aleksandar-spasojevic/BayesXShinyApp:

#' execute a command on bayesX CLI
#'
#' @param prg_path program (in 'bayesX' language) to execute on bayesX
#' @return an object of type 'bayesXResult' which contains the output generated
#' by bayesX CLI
#'
#' @noRd
bayesX <- function(prg_path, ...){
  if ( !file.exists(prg_path) ) stop("program path not present")
  bayesXResult <- suppressWarnings(BayesXsrc::run.bayesx(prg_path, verbose = FALSE)$log)
  class(bayesXResult) <- c("bayesXResult", class(bayesXResult))
  attr(bayesXResult, "prg") <- readLines(prg_path)
  
  # create new data environment, where data is stored
  # TODO: if data_ fails, do not store data environment and proceed further
  data_env <- new.env()
  assign("Data", data_(bayesXResult), envir = data_env)
  
  eval(parse(text = "Ranges <- BayesXShinyApp:::.get_ranges(Data)"), envir = data_env)
  eval(parse(text = "Sequences <- BayesXShinyApp:::.range_to_sequence(Ranges)"), envir = data_env)
  attr(bayesXResult, "data_env") <- data_env
  return(bayesXResult)
}


#' access objects from data environment
#' @noRd
get_ <- function(obj, what, ...) UseMethod("get_")

get_.default <- function(obj, what, ...){
  envir <- attr(obj, "data_env")
  if( is.null(envir) )
    stop("object has no data environment")
  get(what, envir = envir)
}


#' extract information of bayesXResult
#'
#' @param pattern see in \code{\link{grep}}
#' @param ... further arguments passed to \code{\link{grep}}
#' @return a \code{list} with successfull match (\code{character}) and where
#' \code{numeric} match in bayesXResult happend
#'
#' @examples \dontrun{extract(res, "Acceptance rate")
#' library(BayesXShinyApp)
#' res <- bayesX("./inst/template.prg")
#' extract(res, "Acceptance rate")
#' extract(res, "Variance")
#' extract(res, "Minimum")
#' extract(res, "Maximum")
#' ex <- extract(res, "mean")
#' rbind(res[ex$where-1], ex$match, res[ex$where+1])}
#'
#' @noRd
extract <- function(bayesXResult, pattern, ...) UseMethod("extract")

#' @noRd
extract.bayesXResult <- function(bayesXResult, pattern, ...){
  where_match <- grep(pattern, bayesXResult, ...)
  list(match = bayesXResult[where_match], where = where_match)
}


#' get output path generated by bayesX CLI
#'
#' @param bayesXResult is the object generated by \code{\link{bayesX}}
#' @return \code{character} vector which can be interpreted as path
#'
#' @noRd
#' @examples \dontrun{output_path(res)
#' list.files(output_path(res),full.names = TRUE)}
output_path <- function(bayesXResult, ...) UseMethod("output_path")

#' @noRd
output_path.bayesXResult <- function(bayesXResult, ...){
  # some of the output files end with *.res, extract one of them and take the
  # directory of it, which is in sense the 'output'
  path <- extract(bayesXResult, "*.res$", ...)$match[1] # take the first match
  # remove leading|trailing whitespaces or if string 'NOTE ...' present and 
  # return output directory path
  path_clean <- gsub("NOTE: created directory |^\\s+|\\s+$", "", path)
  dir_path <- dirname(path_clean)
  if( dir.exists(dir_path) )
    return(dir_path)
  else
    stop(paste("output path can not be parsed:", path))
}


#' get data used in bayesX supplied program
#'
#' @param bayesXResult is the object generated by \code{\link{bayesX}}
#'
#' @noRd
data_ <- function(bayesXResult, ...) UseMethod("data_")

#' @export
data_.bayesXResult <- function(bayesXResult, header = TRUE, ...){
  program <- attr(bayesXResult, "prg")
  # search 'infile using ' in supplied program (prg). If match available, then
  # extract data path
  key <- "infile using "
  key_match <- grep(key, program, value = TRUE)[1]
  # TODO: filepath can contain 'whitespaces', this is not covered in this pattern
  # and will fail if such path occurs
  data_path <- gsub("^(.*)\\s(.*)(/[^/]+$)", "\\2\\3", key_match)
  if ( !file.exists(data_path) )
    stop(sprintf("%s: can not be parsed", key_match))
  
  return(utils::read.table(data_path, header = header, ...))
}