#' 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, ...))
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.