#' extracts key value pairs from 'output' directory generated by bayesX CLI
#' @note we do not export this method, is an internal method
#' @noRd
get_key_values <- function(line, data_env, ...){
key_values <- unlist(strsplit(line, ","))
meta <- list()
for (pair in key_values) {
splitted <- unlist(strsplit(pair, "="))
# in 'key' remove leading and trailing whitespaces
key <- unlist(gsub("^\\s+|\\s+$", "", splitted[1])); value <- splitted[2]
meta[key] <- value
}
# if line contains 'term' we declare it as an effect
is_effect <- grepl("term", line)
if ( is_effect )
class(meta) <- c("effect", class(meta))
return(meta)
}
#' 'bayesXOutput' + 'effects' constructor for 'output/' files generated by bayesX CLI
#'
#' class which contains information about 'output/' files generated by
#' \code{\link{bayesX}}
#'
#' @param bayesXResult is the object generated by \code{\link{bayesX}}
#'
#' @noRd
bayesXOutput <- function(bayesXResult, ...) UseMethod("bayesXOutput")
bayesXOutput.bayesXResult <- function(bayesXResult, ...){
r_file <- readLines(list.files(output_path(bayesXResult), "*.r$",
full.names = TRUE))
# extract information of .r file in output per line
output_meta <- lapply(r_file, get_key_values, attr(bayesXResult, "data_env"))
class(output_meta) <- c("bayesXOutput", "effects", class(output_meta))
attr(output_meta, "data_env") <- attr(bayesXResult, "data_env")
return(output_meta)
}
#' @note since user only passes the output directory, we do not know where
#' data sample is stored
#'
#' @rdname bayesXOutput
#'
#' @noRd
bayesXOutput.character <- function(path, ...){
# read the .R file created in Output generated by bayesX CLI which contains
# summary information e.g equationtypes
r_file_path <- list.files(path, "*.r$", full.names = TRUE)
if( length(r_file_path) == 0 )
stop( sprintf("there is no .R file generated by bayesX in %s", path) )
r_file <- readLines(r_file_path)
# extract information of .r file in output per line
output_meta <- lapply(r_file, get_key_values, NULL)
# meta object of type 'bayesXOutput' and 'effects'!
class(output_meta) <- c("bayesXOutput", "effects", class(output_meta))
attr(output_meta, "data_env") <- NULL
return(output_meta)
}
#' subscript operator for 'bayesXOutput' objects
#'
#' extracts meta information out of 'output/*.r' file generated by
#' \code{\link{bayesX}}
#'
#' @param bayesXOutput is the object generated by \code{\link{bayesXOutput}}
#'
#' @noRd
"[.bayesXOutput" <- function(bayesXOutput, i, drop = TRUE, ...){
sapply(bayesXOutput, "[", i, drop = drop, ...)
}
#' @export
variables.bayesXOutput <- function(bayesXOutput, ...){
variables <- lapply(bayesXOutput, function(elem){
tryCatch(variables(elem),
warning = function(w) NULL,
error = function(e) NULL)
}, ...)
return( unique(unlist(variables)) )
}
#' @export
predict.effects <- function(bayesXOutput, X, ...){
# tryCatch since some elements of bayesXOutput are not of type 'effect'. If
# one 'elem' is not of type 'effect' we will return 'NULL' otherwise
# 'predict.effect' function is called
force(X)
effects_predicted <- do.call("c", lapply(bayesXOutput, function(elem, ...){
tryCatch(predict(elem, X = X, ...),
warning = function(w) NULL,
error = function(e) NULL)
}, ...))
class(effects_predicted) <- c("effects_predicted", class(effects_predicted))
return( effects_predicted )
}
#' @export
distribution.bayesXOutput <- function(bayesXOutput, ...){
# NOTE: for each equation type there is an distribution attribute, unnecessary
# -> take first element valid; often all equation types of same distribution!
for( distr in bayesXOutput["family"] ){
if (is.null(distr))
next
return( .distributions[[distr]] )
}
if( is.null(distr) )
stop( sprintf("distribution not found, add: %s", distr) )
}
#' @export density.bayesXOutput
density.bayesXOutput <- function(bayesXOutput, X, ...){
params <- parameters(bayesXOutput, X)
return( density(params, ...) )
}
Add the following code to your website.
For more information on customizing the embed code, read Embedding Snippets.