diff --git a/DESCRIPTION b/DESCRIPTION index 72e159de0..865d74851 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -29,6 +29,7 @@ Imports: rlang, shinyjs, stats, + teal.code, teal.logger (>= 0.1.1), utils, yaml diff --git a/NAMESPACE b/NAMESPACE index 122ea7119..e8566b1e1 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -1,120 +1,25 @@ # Generated by roxygen2: do not edit by hand -S3method(as_cdisc,TealDataset) -S3method(as_cdisc,TealDatasetConnector) -S3method(dataset,MultiAssayExperiment) -S3method(dataset,data.frame) -S3method(get_attrs,TealDataset) -S3method(get_code,TealDataAbstract) -S3method(get_code,TealDataset) -S3method(get_code,TealDatasetConnector) -S3method(get_code,default) -S3method(get_dataname,TealDataAbstract) -S3method(get_dataname,TealDataset) -S3method(get_dataname,TealDatasetConnector) -S3method(get_dataset,TealDataAbstract) -S3method(get_dataset,TealDataset) -S3method(get_dataset,TealDatasetConnector) -S3method(get_dataset_label,TealDataset) -S3method(get_dataset_label,TealDatasetConnector) -S3method(get_datasets,TealDataAbstract) -S3method(get_datasets,TealDataset) -S3method(get_datasets,TealDatasetConnector) -S3method(get_key_duplicates,TealDataset) -S3method(get_key_duplicates,data.frame) -S3method(get_keys,TealDataAbstract) -S3method(get_keys,TealDataset) -S3method(get_keys,TealDatasetConnector) -S3method(get_raw_data,TealDataAbstract) -S3method(get_raw_data,TealDataset) -S3method(get_raw_data,TealDatasetConnector) -S3method(is_pulled,TealDataAbstract) -S3method(is_pulled,TealDataset) -S3method(is_pulled,TealDatasetConnector) -S3method(load_dataset,TealDataset) -S3method(load_dataset,TealDatasetConnector) -S3method(load_datasets,TealData) -S3method(load_datasets,TealDataConnector) -S3method(load_datasets,TealDataset) -S3method(load_datasets,TealDatasetConnector) -S3method(mutate_data,TealDataAbstract) -S3method(mutate_dataset,TealDataAbstract) -S3method(mutate_dataset,TealDataset) -S3method(mutate_dataset,TealDatasetConnector) S3method(mutate_join_keys,JoinKeys) -S3method(mutate_join_keys,TealData) -S3method(set_args,CallableCode) -S3method(set_args,CallableFunction) -S3method(set_args,TealDatasetConnector) -S3method(set_keys,TealDataAbstract) -S3method(set_keys,TealDataset) -S3method(set_keys,TealDatasetConnector) -S3method(to_relational_data,MultiAssayExperiment) -S3method(to_relational_data,TealData) -S3method(to_relational_data,TealDataset) -S3method(to_relational_data,TealDatasetConnector) -S3method(to_relational_data,data.frame) -S3method(to_relational_data,list) -export("data_label<-") -export(as_cdisc) -export(callable_code) -export(callable_function) +S3method(mutate_join_keys,tdata) export(cdisc_data) -export(cdisc_data_connector) -export(cdisc_data_file) -export(cdisc_dataset) -export(cdisc_dataset_connector) -export(cdisc_dataset_connector_file) -export(cdisc_dataset_file) -export(code_cdisc_dataset_connector) -export(code_dataset_connector) -export(csv_cdisc_dataset_connector) -export(csv_dataset_connector) -export(data_connection) -export(data_label) -export(dataset) -export(dataset_connector) -export(dataset_connector_file) -export(dataset_file) -export(fun_cdisc_dataset_connector) -export(fun_dataset_connector) -export(get_attrs) -export(get_cdisc_keys) -export(get_code) -export(get_dataname) -export(get_dataset) -export(get_dataset_label) -export(get_datasets) -export(get_key_duplicates) -export(get_keys) -export(get_labels) -export(get_raw_data) -export(is_pulled) +export(ddl) +export(ddl_eval_substitute) +export(ddl_run) +export(default_cdisc_join_keys) +export(get_preprocessing_code) export(join_key) export(join_keys) -export(load_dataset) -export(load_datasets) -export(mae_dataset) -export(mutate_data) -export(mutate_dataset) export(mutate_join_keys) -export(python_cdisc_dataset_connector) -export(python_code) -export(python_dataset_connector) -export(rds_cdisc_dataset_connector) -export(rds_dataset_connector) +export(new_tdata) export(read_script) -export(relational_data_connector) -export(scda_cdisc_dataset_connector) -export(scda_dataset_connector) -export(script_cdisc_dataset_connector) -export(script_dataset_connector) -export(set_args) -export(set_keys) export(teal_data) -export(teal_data_file) -export(to_relational_data) +export(username_password_args) +export(username_password_server) +export(username_password_ui) export(validate_metadata) +exportClasses(tdata) +exportMethods(new_tdata) import(shiny) importFrom(digest,digest) importFrom(formatters,var_labels) diff --git a/R/CDISCTealDataConnector.R b/R/CDISCTealDataConnector.R deleted file mode 100644 index 5f0591c35..000000000 --- a/R/CDISCTealDataConnector.R +++ /dev/null @@ -1,93 +0,0 @@ -# CDISCTealDataConnector ------ -#' -#' @title Manage multiple and `TealDatasetConnector` of the same type. -#' -#' @description `r lifecycle::badge("stable")` -#' Class manages `TealDatasetConnector` to specify additional dynamic arguments and to -#' open/close connection. -#' -#' @param connection (`TealDataConnection`)\cr -#' connection to data source -#' @param connectors (`list` of `TealDatasetConnector` elements)\cr -#' list with dataset connectors -#' -CDISCTealDataConnector <- R6::R6Class( # nolint - classname = "CDISCTealDataConnector", - inherit = TealDataConnector, - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new `CDISCTealDataConnector` object - initialize = function(connection, connectors) { - super$initialize(connection = connection, connectors = connectors) - - new_parent <- list() - for (x in connectors) { - x_dataname <- x$get_dataname() - new_parent[[x_dataname]] <- if (inherits(x, "CDISCTealDatasetConnector")) { - x$get_parent() - } else { - character(0L) - } - } - - if (is_dag(new_parent)) { - stop("Cycle detected in a parent and child dataset graph.") - } - - private$parent <- new_parent - logger::log_trace( - "CDISCTealDataConnector initialized with data: { paste(self$get_datanames(), collapse = ' ') }" - ) - return(invisible(self)) - }, - #' @description - #' Get all datasets parent names - #' @return (named `list`) with dataset name and its corresponding parent dataset name - get_parent = function() { - private$parent - } - ), - - ## __Private Fields ==== - private = list( - parent = list() # list with dataset names and its parent dataset names - ) -) - -#' The constructor of `CDISCTealDataConnector` objects. -#' -#' @description `r lifecycle::badge("stable")` -#' -#' @param connection (`TealDataConnection`)\cr -#' connection to data source -#' @param connectors (`list` of `TealDatasetConnector` elements)\cr -#' list with dataset connectors -#' -#' @examples -#' adsl_cf <- callable_function( -#' function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) -#' ) -#' adae_cf <- callable_function( -#' function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE")))) -#' ) -#' adsl <- cdisc_dataset_connector( -#' "ADSL", adsl_cf, -#' keys = get_cdisc_keys("ADSL"), parent = character(0) -#' ) -#' adae <- cdisc_dataset_connector( -#' "ADAE", adae_cf, -#' keys = get_cdisc_keys("ADAE"), parent = "ADSL" -#' ) -#' data <- cdisc_data_connector( -#' connection = data_connection(open_fun = callable_function(function() "open function")), -#' connectors = list(adsl, adae) -#' ) -#' @return `CDISCTealDataConnector` object -#' @export -cdisc_data_connector <- function(connection, connectors) { - stopifnot(inherits(connection, "TealDataConnection")) - checkmate::assert_list(connectors, types = "TealDatasetConnector", min.len = 1) - CDISCTealDataConnector$new(connection, connectors) -} diff --git a/R/CDISCTealDataset.R b/R/CDISCTealDataset.R deleted file mode 100644 index 22fce4c88..000000000 --- a/R/CDISCTealDataset.R +++ /dev/null @@ -1,211 +0,0 @@ -## CDISCTealDataset ==== -#' -#' @title R6 Class representing a dataset with parent attribute -#' -#' @description `r lifecycle::badge("stable")` -#' Any `data.frame` object can be stored inside this object. -#' -#' The difference compared to `TealDataset` class is a parent field that -#' indicates name of the parent dataset. Note that the parent field might -#' be empty (i.e. `character(0)`). -#' -#' @param dataname (`character`)\cr -#' A given name for the dataset it may not contain spaces -#' -#' @param x (`data.frame`)\cr -#' -#' @param keys (`character`)\cr -#' vector with primary keys -#' -#' @param parent optional, (`character`) \cr -#' parent dataset name -#' -#' @param code (`character`)\cr -#' A character string defining the code needed to produce the data set in `x` -#' -#' @param label (`character`)\cr -#' Label to describe the dataset -#' -#' @param vars (named `list`)) \cr -#' In case when this object code depends on other `TealDataset` object(s) or -#' other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It is recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' -#' @param metadata (named `list` or `NULL`) \cr -#' Field containing metadata about the dataset. Each element of the list -#' should be atomic and length one. -#' -#' @examples -#' x <- cdisc_dataset( -#' dataname = "XYZ", -#' x = data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE), -#' keys = "y", -#' parent = "ABC", -#' code = "XYZ <- data.frame(x = c(1, 2), y = c('aa', 'bb'), -#' stringsAsFactors = FALSE)", -#' metadata = list(type = "example") -#' ) -#' -#' x$ncol -#' x$get_code() -#' x$get_dataname() -#' x$get_keys() -#' x$get_parent() -CDISCTealDataset <- R6::R6Class( # nolint - "CDISCTealDataset", - inherit = TealDataset, - ## __Public Methods ==== - public = list( - #' @description - #' Create a new object of `CDISCTealDataset` class - initialize = function(dataname, x, keys, parent, code = character(0), - label = character(0), vars = list(), metadata = NULL) { - checkmate::assert_character(parent, max.len = 1, any.missing = FALSE) - super$initialize( - dataname = dataname, x = x, keys = keys, code = code, - label = label, vars = vars, metadata = metadata - ) - - self$set_parent(parent) - logger::log_trace("CDISCTealDataset initialized for dataset: { deparse1(self$get_dataname()) }.") - return(invisible(self)) - }, - #' @description - #' Recreate a dataset with its current attributes - #' This is useful way to have access to class initialize method basing on class object - #' - #' @return a new object of `CDISCTealDataset` class - recreate = function(dataname = self$get_dataname(), - x = self$get_raw_data(), - keys = self$get_keys(), - parent = self$get_parent(), - code = private$code, - label = self$get_dataset_label(), - vars = list(), - metadata = self$get_metadata()) { - res <- self$initialize( - dataname = dataname, - x = x, - keys = keys, - parent = parent, - code = code, - label = label, - vars = vars, - metadata = metadata - ) - logger::log_trace("CDISCTealDataset$recreate recreated dataset: { deparse1(self$get_dataname()) }.") - return(res) - }, - #' @description - #' Get all dataset attributes - #' @return (named `list`) with dataset attributes - get_attrs = function() { - x <- super$get_attrs() - x <- append( - x, - list( - parent = self$get_parent() - ) - ) - return(x) - }, - #' @description - #' Get parent dataset name - #' @return (`character`) indicating parent dataname - get_parent = function() { - return(private$parent) - }, - #' @description - #' Set parent dataset name - #' @param parent (`character`) indicating parent dataname - #' @return (`self`) invisibly for chaining - set_parent = function(parent) { - checkmate::assert_character(parent, max.len = 1, any.missing = FALSE) - private$parent <- parent - - logger::log_trace("CDISCTealDataset$set_parent parent set for dataset: { deparse1(self$get_dataname()) }.") - return(invisible(self)) - } - ), - ## __Private Fields ==== - private = list( - parent = character(0) - ) -) - -# constructors ==== -#' Create a new object of `CDISCTealDataset` class -#' -#' @description `r lifecycle::badge("stable")` -#' Function that creates `CDISCTealDataset` object -#' -#' @inheritParams dataset -#' @param parent (`character`, optional) parent dataset name -#' -#' @return (`CDISCTealDataset`) a dataset with connected metadata -#' -#' @export -#' -#' @examples -#' library(scda) -#' -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' -#' cdisc_dataset("ADSL", ADSL, metadata = list(type = "scda", date = "latest")) -cdisc_dataset <- function(dataname, - x, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0), "ADSL"), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL) { - CDISCTealDataset$new( - dataname = dataname, - x = x, - keys = keys, - parent = parent, - label = label, - code = code, - vars = vars, - metadata = metadata - ) -} - -#' Load `CDISCTealDataset` object from a file -#' -#' @description `r lifecycle::badge("experimental")` -#' Please note that the script has to end with a call creating desired object. The error will be raised otherwise. -#' -#' @inheritParams dataset_file -#' -#' @return (`CDISCTealDataset`) object -#' -#' @export -#' -#' @examples -#' # simple example -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(teal.data) -#' library(scda) -#' -#' cdisc_dataset(dataname = \"ADSL\", -#' x = synthetic_cdisc_data('latest')$adsl, -#' code = \"library(scda)\nADSL <- synthetic_cdisc_data('latest')$adsl\")" -#' ), -#' con = file_example -#' ) -#' x <- cdisc_dataset_file(file_example, code = character(0)) -#' get_code(x) -cdisc_dataset_file <- function(path, code = get_code(path)) { - object <- object_file(path, "CDISCTealDataset") - object$set_code(code) - return(object) -} diff --git a/R/CDISCTealDatasetConnector.R b/R/CDISCTealDatasetConnector.R deleted file mode 100644 index 973780f08..000000000 --- a/R/CDISCTealDatasetConnector.R +++ /dev/null @@ -1,133 +0,0 @@ -## CDISCTealDatasetConnector ==== -#' -#' @title A `CDISCTealDatasetConnector` class of objects -#' -#' @description `r lifecycle::badge("stable")` -#' Objects of this class store the connection function to fetch a single dataset. -#' -#' The difference compared to `TealDatasetConnector` is a parent field that -#' indicates name of the parent dataset. Note that the parent field might -#' be empty (i.e. `character(0)`). -#' -#' @param dataname (`character`)\cr -#' A given name for the dataset it may not contain spaces -#' -#' @param pull_callable (`CallableFunction`)\cr -#' function with necessary arguments set to fetch data from connection. -#' -#' @param keys (`character`)\cr -#' vector of dataset primary keys column names -#' -#' @param parent optional, (`character`) \cr -#' parent dataset name -#' -#' @param label (`character`)\cr -#' Label to describe the dataset. -#' -#' @param code (`character`)\cr -#' A character string defining code to modify `raw_data` from this dataset. To modify -#' current dataset code should contain at least one assignment to object defined in `dataname` -#' argument. For example if `dataname = ADSL` example code should contain -#' `ADSL <- `. Can't be used simultaneously with `script` -#' -#' @param script (`character`)\cr -#' Alternatively to `code` - location of the file containing modification code. -#' Can't be used simultaneously with `script`. -#' -#' @param vars (named `list`)) \cr -#' In case when this object code depends on other `TealDataset` object(s) or -#' other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' -#' @param metadata (named `list`, `NULL` or `CallableFunction`) \cr -#' Field containing either the metadata about the dataset (each element of the list -#' should be atomic and length one) or a `CallableFuntion` to pull the metadata -#' from a connection. This should return a `list` or an object which can be -#' converted to a list with `as.list`. -CDISCTealDatasetConnector <- R6::R6Class( # nolint - classname = "CDISCTealDatasetConnector", - inherit = TealDatasetConnector, - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new `TealDatasetConnector` object. Set the pulling function - #' `CallableFunction` which returns a `data.frame`, e.g. by reading - #' from a function or creating it on the fly. - initialize = function(dataname, - pull_callable, - keys, parent, - code = character(0), - label = character(0), - vars = list(), - metadata = NULL) { - super$initialize( - dataname = dataname, - pull_callable = pull_callable, - keys = keys, - code = code, - label = label, - vars = vars, - metadata = metadata - ) - private$set_parent(parent) - logger::log_trace("CDISCTealDatasetConnector initialized for dataset: { deparse1(self$get_dataname()) }") - - return(invisible(self)) - }, - #' @description - #' Get parent dataset name - #' @return (`character`) indicating parent dataname - get_parent = function() { - private$parent - }, - - #' @description - #' Pull the data - #' - #' Read or create the data using `pull_callable` specified in the constructor. - #' - #' @param args (`NULL` or named `list`)\cr - #' additional dynamic arguments for pull function. `args` can be omitted if `pull_callable` - #' from constructor already contains all necessary arguments to pull data. One can try - #' to execute `pull_callable` directly by `x$pull_callable$run()` or to get code using - #' `x$pull_callable$get_code()`. `args` specified in pull are used temporary to get data but - #' not saved in code. - #' @param try (`logical` value)\cr - #' whether perform function evaluation inside `try` clause - #' - #' @return `self` invisibly for chaining. - pull = function(args = NULL, try = FALSE) { - logger::log_trace("CDISCTealDatasetConnector$pull pulling dataset: { deparse1(self$get_dataname()) }.") - super$pull(args = args, try = try) - - if (!self$is_failed()) { - private$dataset <- as_cdisc( - private$dataset, - parent = self$get_parent() - ) - logger::log_trace("CDISCTealDatasetConnector$pull pulled dataset: { deparse1(self$get_dataname()) }.") - } else { - logger::log_error("CDISCTealDatasetConnector$pull failed to pull dataset: { deparse1(self$get_dataname()) }.") - } - return(invisible(self)) - } - ), - - ## __Private Fields ==== - private = list( - parent = character(0), - - ## __Private Methods ==== - set_parent = function(parent) { - checkmate::assert_character(parent, max.len = 1, any.missing = FALSE) - private$parent <- parent - return(invisible(self)) - } - ) -) diff --git a/R/Callable.R b/R/Callable.R deleted file mode 100644 index ee80cb4b7..000000000 --- a/R/Callable.R +++ /dev/null @@ -1,147 +0,0 @@ -## Callable ==== -#' -#' @title A \code{Callable} class of objects -#' -#' @description Object that stores function name with its arguments. Methods to get call and run it. -#' @keywords internal -#' -Callable <- R6::R6Class( # nolint - "Callable", - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new \code{CallableCode} object - #' - #' @param env (\code{environment})\cr - #' environment where the call will be evaluated - #' - #' @return new \code{CallableCode} object - initialize = function(env) { - stopifnot(is.environment(env)) - private$env <- env - logger::log_trace("Callable initialized.") - return(invisible(self)) - }, - #' @description - #' Assigns \code{x <- value} object to \code{env}. Assigned object can't - #' be modified within local environment as it will be locked by using - #' \code{lockBinding}. This also means that this object can't be reassigned - #' which will throw an error. - #' @param x (\code{character} value)\cr - #' name of the variable in class environment - #' @param value (\code{data.frame})\cr - #' object to be assigned to \code{x} - #' - #' @return (\code{self}) invisibly for chaining. - assign_to_env = function(x, value) { - # assign variable once - if (!exists(x, envir = private$env)) { - assign(x, value, envir = private$env) - - # variable can't be modified - lockBinding(sym = x, env = private$env) - logger::log_trace("Callable$assign_to_env assigned '{ x }' to the environment.") - } - - return(invisible(self)) - }, - #' @description - #' Execute \code{Callable} function or code. - #' - #' @param return (\code{logical} value)\cr - #' whether to return an object - #' @param args (\code{NULL} or named \code{list})\cr - #' supplied for callable functions only, these are dynamic arguments passed to function. - #' Dynamic arguments are executed in this call and are not saved which means that - #' \code{self$get_call()} won't include them later. - #' @param try (\code{logical} value)\cr - #' whether perform function evaluation inside \code{try} clause - #' - #' @return nothing or output from function depending on \code{return} - #' argument. If \code{run} fails it will return object of class \code{simple-error error} - #' when \code{try = TRUE} or will stop if \code{try = FALSE}. - run = function(return = TRUE, args = NULL, try = FALSE) { - checkmate::assert_flag(return) - checkmate::assert_list(args, names = "unique", min.len = 0, null.ok = TRUE) - checkmate::assert_flag(try) - - # args are "dynamic" are used only to evaluate this call - # - args not saved to private$call persistently - expr <- self$get_call(deparse = FALSE, args = args) - - res <- tryCatch( - eval(expr, envir = private$env), - error = function(e) e - ) - private$check_run_output(res, try = try) - - logger::log_trace("Callable$run callable has been run.") - if (return) { - return(res) - } else { - return(invisible(NULL)) - } - }, - #' @description - #' Check if evaluation of the function has not failed. - #' - #' @return (\code{logical}) \code{TRUE} if evaluation of the function failed or \code{FALSE} - #' if evaluation failed or function hasn't yet been called. - is_failed = function() { - return(private$failed) - }, - #' @description - #' Get error message from last function execution - #' - #' @return (\code{character}) object with error message or \code{character(0)} if last - #' function evaluation was successful. - get_error_message = function() { - return(private$error_msg) - } - ), - - ## __Private Fields ==== - private = list( - call = NULL, # a call object - env = NULL, # environment where function is called - failed = FALSE, - error_msg = character(0), - ## __Private Methods ==== - - # The deep clone function deep clones the environment of the Callable so - # that it is distinct for the copy - deep_clone = function(name, value) { - deep_clone_r6(name, value) - }, - # Checks output and handles error messages - check_run_output = function(res, try) { - if (inherits(res, "error")) { - msg <- conditionMessage(res) - is_locked <- grepl(pattern = "cannot change value of locked", x = msg) - - error_msg <- if (is_locked) { - locked_var <- gsub("^.+\\'(.+)\\'$", "\\1", x = msg) - sprintf( - "Modification of the local variable '%1$s' is not allowed. %2$s '%1$s'", - locked_var, - "Please add proxy variable to CallableCode to obtain results depending on altered" - ) - } else { - msg - } - - if (try) { - private$failed <- TRUE - private$error_msg <- error_msg - logger::log_error("Callable$check_run_output { deparse1(error_msg) }.") - } else { - stop(error_msg, call. = FALSE) - } - } else { - private$failed <- FALSE - private$error_msg <- character(0) - } - } - ) -) diff --git a/R/CallableCode.R b/R/CallableCode.R deleted file mode 100644 index 383b91d69..000000000 --- a/R/CallableCode.R +++ /dev/null @@ -1,127 +0,0 @@ -## CallableCode ==== -#' -#' @title A \code{CallableCode} class of objects -#' -#' @description `r lifecycle::badge("stable")` -#' Object that stores code to reproduce an object. It includes methods to -#' get or run the code and return the object. -#' -CallableCode <- R6::R6Class( # nolint - "CallableCode", - inherit = Callable, - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new \code{CallableCode} object - #' - #' @param code (\code{character})\cr - #' a string containing R code to reproduce the desired object. - #' @param env (\code{environment})\cr - #' environment where function will be evaluated - #' - #' @return new \code{CallableCode} object - initialize = function(code, env = new.env(parent = parent.env(globalenv()))) { - if (!checkmate::test_string(code)) { - stop("A string of length one containing the code needed to produce the object must be provided.") - } - - # reposition all library calls in the code so that they are - # visible in the new env - env$library <- function(...) { - mc <- match.call() - mc[[1]] <- quote(base::library) - eval(mc, envir = globalenv()) - this_env <- parent.frame() - - if (!identical(this_env, globalenv())) { - parent.env(this_env) <- parent.env(globalenv()) - } - } - - super$initialize(env = env) - - private$code <- code - private$call <- private$get_callable_code(code) - logger::log_trace("CallableCode initialized.") - - return(invisible(self)) - }, - #' @description - #' Get sequence of calls from the code supplied to produce the object. - #' - #' @param deparse (\code{logical} value)\cr - #' whether to return a deparsed version of call - #' @param args (\code{NULL})\cr - #' available to be consistent with \code{CallableFunction} but are not used to - #' retrieve the call. - #' - #' @return \code{list} of \code{calls} or \code{character} depending on \code{deparse} argument - get_call = function(deparse = TRUE, args = NULL) { - checkmate::assert_flag(deparse) - if (!is.null(args)) { - stop("'args' are not used to retrieve the call.") - } - - res <- if (deparse) { - paste0(vapply(private$call, deparse1, character(1)), collapse = "\n") - } else { - private$call - } - - return(res) - } - ), - - ## __Private Fields ==== - private = list( - code = NULL, - ## __Private Methods ==== - # @description - # Determines whether code is valid and callable. If not then stores error message. - # - # @param code \code{character} string to check - # - # @return \code{expression} parsed from the supplied code - # - get_callable_code = function(code) { - expr <- tryCatch( - str2expression(code), - error = function(e) { - private$error_msg <- e$message - private$failed <- TRUE - } - ) - if (length(expr) >= 1 && !private$failed) { - return(expr) - } else { - stop(paste("Code supplied is not valid:", private$error_msg)) - } - } - ) -) - -## Constructors ==== - -#' Create \code{\link{CallableCode}} object -#' -#' @description `r lifecycle::badge("stable")` -#' -#' Create \link{CallableCode} object to execute specific code and get reproducible call. -#' -#' @param code (\code{character})\cr -#' a string containing R code to reproduce the desired object. Please be aware -#' that objects assigned to temporary environment are locked which means -#' that they can't be modified. -#' -#' @return \code{CallableCode} object -#' -#' @export -#' -#' @examples -#' cf <- callable_code(code = "mtcars") -#' cf$run() -#' cf$get_call() -callable_code <- function(code) { - CallableCode$new(code) -} diff --git a/R/CallableFunction.R b/R/CallableFunction.R deleted file mode 100644 index 4eb87c68f..000000000 --- a/R/CallableFunction.R +++ /dev/null @@ -1,277 +0,0 @@ -## CallableFunction ==== -#' -#' @title A \code{CallableFunction} class of objects -#' -#' @description Object that stores a function name together with its arguments. -#' Methods are then available to get the function call and evaluate it. -#' -#' @keywords internal -#' -CallableFunction <- R6::R6Class( # nolint - "CallableFunction", - inherit = Callable, - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new \code{CallableFunction} object - #' - #' @param fun (\code{function})\cr - #' function to be evaluated in class. - #' This is either a `function` object or its name as a string. - #' @param env (\code{environment})\cr - #' environment where function will be evaluated - #' - #' @return new \code{CallableFunction} object - initialize = function(fun, env = new.env(parent = parent.env(globalenv()))) { - super$initialize(env = env) - if (missing(fun)) { - stop("A valid function name must be provided.") - } - if (!(checkmate::test_string(fun) || is.function(fun) || is.call(fun) || is.symbol(fun))) { - stop("CallableFunction can be specified as character, symbol, call or function") - } - - fun_name <- private$get_callable_function(fun) - private$fun_name <- deparse1(fun_name, collapse = "\n") - - private$refresh() - - logger::log_trace("CallableFunction initialized with function: { deparse1(private$fun_name) }.") - - return(invisible(self)) - }, - #' @description - #' get the arguments a function gets called with - #' - #' @return arguments the function gets called with - get_args = function() { - return(private$args) - }, - #' @description - #' Get function call with substituted arguments in \code{args}. - #' These arguments will not be stored in the object. - #' - #' @param deparse (\code{logical} value)\cr - #' whether to return a deparsed version of call - #' @param args (\code{NULL} or named \code{list})\cr - #' dynamic arguments to function - #' - #' @return \code{call} or \code{character} depending on \code{deparse} argument - get_call = function(deparse = TRUE, args = NULL) { - checkmate::assert_flag(deparse) - checkmate::assert_list(args, names = "strict", min.len = 0, null.ok = TRUE) - - old_args <- private$args - if (length(args) > 0) self$set_args(args) - - res <- if (deparse) { - deparse1(private$call, collapse = "\n") - } else { - private$call - } - - # set args back to default - if (length(args) > 0) { - lapply(names(args), self$set_arg_value, NULL) - self$set_args(old_args) - } - - return(res) - }, - #' @description - #' Set up function arguments - #' - #' @param args (\code{NULL} or named \code{list})\cr - #' function arguments to be stored persistently in the object. Setting \code{args} doesn't - #' remove other \code{args}, only create new of modify previous of the same name. - #' To clean arguments specify \code{args = NULL}. - #' - #' @return (`self`) invisibly for chaining. - set_args = function(args) { - # remove args if empty - if (length(args) == 0) { - private$args <- NULL - private$refresh() - return(invisible(self)) - } - checkmate::assert_list(args, min.len = 0, names = "unique") - - for (idx in seq_along(args)) { - self$set_arg_value( - name = names(args)[[idx]], - value = args[[idx]] - ) - } - logger::log_trace( - "CallableFunction$set_args args set for function: { deparse1(private$fun_name) }." - ) - - return(invisible(self)) - }, - #' @description - #' Set up single function argument with value - #' - #' @param name (\code{character}) argument name - #' @param value argument value - #' - #' @return (`self`) invisibly for chaining. - set_arg_value = function(name, value) { - checkmate::assert_string(name) - arg_names <- names(formals(eval(str2lang(private$fun_name)))) - stopifnot(name %in% arg_names || "..." %in% arg_names || is.null(arg_names)) - - if (length(private$args) == 0) { - private$args <- list() - } - private$args[[name]] <- value - - private$refresh() - logger::log_trace("CallableFunction$set_arg_value args values set for arg: { deparse1(name) }.") - - return(invisible(self)) - } - ), - - ## __Private Fields ==== - private = list( - fun_name = character(0), - args = NULL, # named list with argument names and values - ## __Private Methods ==== - # @description - # Refresh call with function name and saved arguments - # - # @return nothing - refresh = function() { - if (!is.null(private$fun_name) || !identical(private$fun_name, character(0))) { - - # replaced str2lang found at: - # https://rlang.r-lib.org/reference/call2.html - private$call <- as.call( - c(rlang::parse_expr(private$fun_name), private$args) - ) - - # exception for source(...)$value - if (private$fun_name == "source") { - private$call <- rlang::parse_expr( - sprintf("%s$value", deparse1(private$call, collapse = "\n")) - ) - } else if (private$fun_name %in% c("py_run_file", "py_run_string")) { - private$call <- rlang::parse_expr( - sprintf("%s[[%s]]", deparse1(private$call, collapse = "\n"), deparse1(private$object, collapse = "\n")) - ) - } - } - }, - # @description - # Returns a call to a function - # - # Returns the call to the function as defined in the enclosing environment. - # - # @param callable \code{function, character, call, symbol} the function to return - # - # @return `call` the call to the function - # - get_callable_function = function(callable) { - if (is.character(callable) && private$is_prefixed_function(callable)) { - private$get_call_from_prefixed_function(callable) - } else { - private$get_call_from_symbol(callable) - } - }, - # @param function_name (`character`) the function name prefixed with \code{::} - # and the package name - # @return `call` the call to the function passed to this method - get_call_from_prefixed_function = function(function_name) { - package_function_names <- strsplit(function_name, "::")[[1]] - fun <- get(package_function_names[2], envir = getNamespace(package_function_names[1])) - if (!is.function(fun)) { - stop(sprintf("object '%s' of mode 'function' was not found", function_name)) - } - str2lang(function_name) - }, - # @param symbol (`function`, `symbol` or `character`) the item matching a function - # @return `call` the call to the function passed to this method - get_call_from_symbol = function(symbol) { - fun <- match.fun(symbol) - fun_environment <- environment(fun) - if (isNamespace(fun_environment)) { - fun_name <- get_binding_name(fun, fun_environment) - namespace_name <- strsplit(rlang::env_name(fun_environment), ":")[[1]][2] - if (namespace_name != "base") { - fun_name <- paste(namespace_name, fun_name, sep = "::") - } - fun <- str2lang(fun_name) - } - fun - }, - # Checks whether a character vector is of this format - # :: - # - # @param function_name (`character`) the character vector - # @return `logical` `TRUE` if \code{function_name} is of the specified - # format; `FALSE` otherwise - # - is_prefixed_function = function(function_name) { - grepl("^[[:ascii:]]+::[[:ascii:]]+$", function_name, perl = TRUE) - } - ) -) - -## Constructors ==== - -#' Create \code{CallableFunction} object -#' -#' @description `r lifecycle::badge("stable")` -#' Create \code{\link{CallableFunction}} object to execute specific function and get reproducible -#' call. -#' -#' @param fun (\code{function})\cr -#' any R function, directly by name or \code{character} string. -#' -#' @return \code{CallableFunction} object -#' -#' @export -#' -#' @examples -#' cf <- callable_function(fun = stats::median) -#' cf$set_args(list(x = 1:10, na.rm = FALSE)) -#' cf$run() -#' cf$get_call() -callable_function <- function(fun) { - CallableFunction$new(fun) -} - -#' Gets the name of the binding -#' -#' Gets the name of the object by finding its origin. -#' Depending on type of object function uses different methods -#' to obtain original location. If no `env` is specified then -#' object is tracked by `substitute` along the `sys.frames`. -#' If `env` is specified then search is limited to specified -#' environment.\cr -#' -#' @note -#' Raises an error if the object is not found in the environment. -#' -#' @param object (R object)\cr -#' any R object -#' @param envir (`environment`)\cr -#' if origin of the object is known then should be provided for -#' more precise search -#' @return character -#' @keywords internal -#' -get_binding_name <- function(object, envir) { - bindings_names <- ls(envir) - identical_binding_mask <- vapply( - bindings_names, - function(binding_name) identical(get(binding_name, envir), object), - FUN.VALUE = logical(1), - USE.NAMES = FALSE - ) - if (length(bindings_names[identical_binding_mask]) == 0) { - stop("Object not found in the environment") - } - bindings_names[identical_binding_mask] -} diff --git a/R/CallablePythonCode.R b/R/CallablePythonCode.R deleted file mode 100644 index 673f0f359..000000000 --- a/R/CallablePythonCode.R +++ /dev/null @@ -1,224 +0,0 @@ -## CallablePythonCode ==== -#' -#' @title A `CallablePythonCode` class of objects -#' @keywords internal -#' -CallablePythonCode <- R6::R6Class( # nolint - - ## __Public Methods ==== - classname = "CallablePythonCode", - inherit = CallableFunction, - public = list( - #' @description - #' Create a new `CallablePythonCode` object - #' - #' @param fun (`function`)\cr - #' function to be evaluated in class. Function should be named - #' @param env (\code{environment})\cr - #' environment where the result of python code evaluation are stored - #' @return new `CallablePythonCode` object - initialize = function(fun, env = new.env(parent = parent.env(globalenv()))) { - if (!requireNamespace("reticulate", quietly = TRUE)) { - stop("Cannot load package 'reticulate' - please install the package.", call. = FALSE) - } - if (utils::packageVersion("reticulate") < 1.22) { - stop("Please upgrade package 'reticulate', teal.data requires version >= 1.22") - } - - super$initialize(fun = fun, env = env) - logger::log_trace("CallablePythonCode initialized.") - return(invisible(self)) - }, - #' @description - #' For scripts and code that contain multiple objects, save the name - #' of the object that corresponds to the final dataset of interest. - #' This is required for running python scripts with `reticulate`. - #' - #' @param x (`character`) the name of the object produced by the code - #' or script. - #' - #' @return (`self`) invisibly for chaining. - set_object = function(x) { - private$object <- x - private$refresh() - logger::log_trace("CallablePythonCode$set_object object set.") - return(invisible(self)) - }, - #' @description - #' Execute `Callable` python code. - #' - #' @param args (`NULL` or named `list`)\cr - #' supplied for callable functions only, these are dynamic arguments passed to - #' `reticulate::py_run_string` or `reticulate::py_run_file`. Dynamic arguments - #' are executed in this call and are not saved which means that `self$get_call()` - #' won't include them later. - #' @param try (`logical` value)\cr - #' whether perform function evaluation inside `try` clause - #' - #' @return nothing or output from function depending on `return` - #' argument. If `run` fails it will return object of class `simple-error` error - #' when `try = TRUE` or will stop if `try = FALSE`. - run = function(args = NULL, try = FALSE) { - rlang::with_options( - res <- super$run(args = args, try = try), - reticulate.engine.environment = private$env - ) - if (is.null(res)) { - stop("The specified python object returned NULL or does not exist in the python code") - } - res - } - ), - - ## __Private Fields ==== - private = list( - object = NULL, - - ## __Private Methods ==== - # @description - # Refresh call with function name and saved arguments - # - # @return nothing - refresh = function() { - # replaced str2lang found at: - # https://rlang.r-lib.org/reference/call2.html - private$call <- as.call( - c(rlang::parse_expr(private$fun_name), private$args) - ) - - private$call <- rlang::parse_expr( - sprintf("%s[[%s]]", deparse1(private$call, collapse = "\n"), deparse1(private$object, collapse = "\n")) - ) - } - ) -) -## PythonCodeClass ==== -#' -#' @title A `CallablePythonCode` class of objects -#' @description `r lifecycle::badge("experimental")` -#' -PythonCodeClass <- R6::R6Class( # nolint - classname = "PythonCodeClass", - inherit = CodeClass, - - ## __Public Methods ==== - public = list( - #' @description - #' Evaluates internal code within environment - #' - #' @param vars (named `list`) additional pre-requisite vars to execute code - #' @param dataname (`character`) name of the data frame object to be returned - #' @param envir (`environment`) environment in which code will be evaluated - #' - #' @return `data.frame` containing the mutated dataset - eval = function(vars = list(), dataname = NULL, envir = new.env(parent = parent.env(.GlobalEnv))) { - checkmate::assert_list(vars, min.len = 0, names = "unique") - execution_environment <- envir - - for (vars_idx in seq_along(vars)) { - var_name <- names(vars)[[vars_idx]] - var_value <- vars[[vars_idx]] - if (inherits(var_value, "TealDatasetConnector") || inherits(var_value, "TealDataset")) { - var_value <- get_raw_data(var_value) - } - assign(envir = execution_environment, x = var_name, value = var_value) - } - - # execute - rlang::with_options( - super$eval(envir = execution_environment), - reticulate.engine.environment = execution_environment - ) - - # return early if only executing and not grabbing the dataset - if (is.null(dataname)) { - return(as.environment(as.list(execution_environment))) - } - - if (!is.data.frame(execution_environment[[dataname]])) { - out_msg <- sprintf( - "\n%s\n\n - Code from %s needs to return a data.frame assigned to an object of dataset name.", - self$get_code(), - self$get_dataname() - ) - - rlang::with_options( - .expr = stop(out_msg, call. = FALSE), - warning.length = max(min(8170, nchar(out_msg) + 30), 100) - ) - } - - new_set <- execution_environment[[dataname]] - logger::log_trace("PythonCodeClass$eval successfuly evaluated the code.") - - return(new_set) - } - ) -) - -#' Python Code -#' -#' `r lifecycle::badge("experimental")` -#' Create a python code object directly from python code or a -#' script containing python code. -#' -#' @details -#' Used to mutate dataset connector objects with python code. See -#' [`mutate_dataset`] or [`mutate_data`] for details. -#' -#' @param code (`character`)\cr -#' Code to mutate the dataset. Must contain the `dataset$dataname`. -#' @param script (`character`)\cr -#' file that contains python Code that can be read using `reticulate::py_run_script`. -#' -#' @return (`PythonCodeClass`) object containing python code -#' @export -#' -#' @examples -#' \dontrun{ -#' library(scda) -#' library(reticulate) -#' library(magrittr) -#' -#' # mutate dataset object -#' -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' -#' x <- scda_cdisc_dataset_connector("ADSL", "adsl") -#' -#' x %>% mutate_dataset(python_code("import pandas as pd -#' r.ADSL = pd.DataFrame({'x': [1]})")) -#' -#' x$get_code() -#' x$pull() -#' x$get_raw_data() -#' -#' # mutate data object -#' -#' y <- 8 -#' tc <- cdisc_data( -#' scda_cdisc_dataset_connector("ADSL", "adsl"), -#' scda_cdisc_dataset_connector("ADLB", "adlb") -#' ) -#' -#' tc %>% mutate_data(python_code("import pandas as pd -#' r.ADSL = pd.DataFrame({'STUDYID': [r.y], 'USUBJID': [r.y]})"), vars = list(y = y)) -#' -#' -#' load_datasets(tc) # submit all -#' ds <- tc$get_dataset("ADSL") -#' ds$get_raw_data() -#' } -python_code <- function(code = character(0), script = character(0)) { - if (!xor(missing(code), missing(script))) stop("Exactly one of 'code' and 'script' is required") - - if (length(script) > 0) { - code <- deparse(call("py_run_file", script)) - } else { - code <- deparse(call("py_run_string", code)) - } - py <- PythonCodeClass$new() - py$set_code(code) - - return(py) -} diff --git a/R/CodeClass.R b/R/CodeClass.R index 6d13d939e..00e67c4e7 100644 --- a/R/CodeClass.R +++ b/R/CodeClass.R @@ -5,12 +5,12 @@ #' #' @examples #' cc <- teal.data:::CodeClass$new() -#' cc$set_code(c("foo <- function() {1}", "foo2 <- function() {2}")) +#' cc$set_code(c("ddl_run <- function() {1}", "ddl_run2 <- function() {2}")) #' cc$get_code() #' cc$get_code(deparse = FALSE) #' #' cc$set_code(c("DF <- data.frame(x = 1:10)", "DF$y <- 1"), "DF") -#' cc$set_code("DF$a <- foo()", "DF") +#' cc$set_code("DF$a <- ddl_run()", "DF") #' #' # dependent dataset #' cc$set_code(c("DF2 <- data.frame(x2 = 1:10)", "DF2$y2 <- DF$y"), "DF2", deps = "DF") @@ -48,7 +48,7 @@ #' x$get_code("DF3") #' #' # mutation simulation -#' x$set_code("DF3$x <- foo(DF$x)", "DF3", deps = "DF") +#' x$set_code("DF3$x <- ddl_run(DF$x)", "DF3", deps = "DF") #' x$get_code("DF3") CodeClass <- R6::R6Class( # nolint "CodeClass", diff --git a/R/JoinKeys.R b/R/JoinKeys.R index 457a4d495..d6b450f30 100644 --- a/R/JoinKeys.R +++ b/R/JoinKeys.R @@ -423,8 +423,8 @@ mutate_join_keys.JoinKeys <- function(x, dataset_1, dataset_2, val) { #' #' mutate_join_keys(x, "ADSL", "ADRS", c("COLUMN1" = "COLUMN2")) #' x$get_join_keys()$get("ADSL", "ADRS") -mutate_join_keys.TealData <- function(x, dataset_1, dataset_2, val) { # nolint - x$mutate_join_keys(dataset_1, dataset_2, val) +mutate_join_keys.tdata <- function(x, dataset_1, dataset_2, val) { # nolint + x@join_keys$mutate_join_keys(dataset_1, dataset_2, val) } @@ -475,3 +475,40 @@ join_key <- function(dataset_1, dataset_2, keys) { class = "JoinKeySet" ) } + +#' @export +default_cdisc_join_keys <- function(datanames) { + jk_list <- default_cdisc_keys[tolower(names(default_cdisc_keys)) %in% tolower(datanames)] + parents <- unlist(sapply(jk_list, function(x) x$parent)) + primary_keys <- Filter( + Negate(is.null), + lapply(names(jk_list), function(i) { + join_key( + dataset_1 = i, + dataset_2 = i, + jk_list[[i]]$primary + ) + }) + ) + foreign <- Filter( + Negate(is.null), + lapply(names(jk_list), function(i) { + if (!is.null(jk_list[[i]]$parent)) + join_key( + dataset_1 = i, + dataset_2 = jk_list[[i]]$parent, + jk_list[[i]]$foreign + ) + }) + ) + + jk_obj <- do.call(join_keys, c(primary_keys, foreign)) + jk_obj$set_parents(parents) + jk_obj +} + + + + +# todo: need a parent_join_key? join_key(dataset_1, dataset_2, keys, parent = TRUE)? +# \ No newline at end of file diff --git a/R/MAETealDataset.R b/R/MAETealDataset.R deleted file mode 100644 index cf8c18173..000000000 --- a/R/MAETealDataset.R +++ /dev/null @@ -1,340 +0,0 @@ -## MAETealDataset ==== -#' -#' @title R6 Class representing a `MultiAssayExperiment` object with its attributes -#' -#' @description `r lifecycle::badge("experimental")` -#' Any `MultiAssayExperiment` object can be stored inside this `MAETealDataset`. -#' Some attributes like colnames, dimension or column names for a specific type will -#' be automatically derived. -#' -#' -#' @param dataname (`character`)\cr -#' A given name for the dataset it may not contain spaces -#' @param x (`MultiAssayExperiment`)\cr -#' @param keys optional, (`character`)\cr -#' A vector of primary keys -#' @param code (`character` or `CodeClass`)\cr -#' A character string defining the code needed to produce the data set in `x`. -#' initialize()` and `recreate()` accept code as `CodeClass` -#' which is also needed to preserve the code uniqueness and correct order. -#' @param label (`character`)\cr -#' Label to describe the dataset -#' @param vars (named `list`)) \cr -#' In case when this object code depends on other `TealDataset` object(s) or -#' other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It is recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' @param metadata (named `list` or `NULL`) \cr -#' Field containing metadata about the dataset. Each element of the list -#' should be atomic and of length one. -#' -#' @seealso [`TealDataset`] -#' -MAETealDataset <- R6::R6Class( # nolint - "MAETealDataset", - inherit = TealDataset, - ## __Public Methods ==== - public = list( - #' @description - #' Create a new object of `MAETealDataset` class - #' - initialize = function(dataname, - x, - keys = character(0), - code = character(0), - label = character(0), - vars = list(), - metadata = NULL) { - if (!requireNamespace("MultiAssayExperiment", quietly = TRUE)) { - stop("Cannot load MultiAssayExperiment - please install the package or restart your session.") - } - checkmate::assert_string(dataname) - stopifnot(inherits(x, "MultiAssayExperiment")) - checkmate::assert_character(keys, any.missing = FALSE) - checkmate::assert( - checkmate::check_character(code, max.len = 1, any.missing = FALSE), - checkmate::check_class(code, "CodeClass") - ) - checkmate::assert_character(label, max.len = 1, null.ok = TRUE, any.missing = FALSE) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - # validate metadata as a list of length one atomic - validate_metadata(metadata) - - private$.raw_data <- x - private$metadata <- metadata - private$set_dataname(dataname) - self$set_vars(vars) - self$set_dataset_label(label) - self$set_keys(keys) - - # needed if recreating dataset - we need to preserve code order and uniqueness - private$code <- CodeClass$new() - if (is.character(code)) { - self$set_code(code) - } else { - private$code$append(code) - } - - logger::log_trace("MAETealDataset$initialize initialized dataset: { deparse1(self$get_dataname()) }.") - - return(invisible(self)) - }, - # ___ check ==== - #' @description - #' Check to determine if the raw data is reproducible from the `get_code()` code. - #' @return - #' `TRUE` if the dataset generated from evaluating the - #' `get_code()` code is identical to the raw data, else `FALSE`. - check = function() { - logger::log_trace( - "TealDataset$check executing the code to reproduce dataset: { deparse1(self$get_dataname()) }..." - ) - if (!checkmate::test_character(self$get_code(), len = 1, pattern = "\\w+")) { - stop( - sprintf( - "Cannot check preprocessing code of '%s' - code is empty.", - self$get_dataname() - ) - ) - } - - new_set <- private$execute_code( - code = self$get_code_class(), - vars = private$vars - ) - res_check <- tryCatch( - { - identical(self$get_raw_data(), new_set) - }, - error = function(e) { - FALSE - } - ) - logger::log_trace("TealDataset$check { deparse1(self$get_dataname()) } reproducibility result: { res_check }.") - - return(res_check) - }, - #' @description - #' Check if keys has been specified correctly for dataset. Set of `keys` - #' should distinguish unique rows or be `character(0)`. - #' - #' @return `TRUE` if dataset has been already pulled, else `FALSE` - check_keys = function(keys = private$.keys) { - if (length(keys) > 0) { - if (!all(keys %in% self$get_colnames())) { - stop("Primary keys specifed for ", self$get_dataname(), " do not exist in the data.") - } - - duplicates <- get_key_duplicates(as.data.frame(SummarizedExperiment::colData(self$get_raw_data())), keys) - if (nrow(duplicates) > 0) { - stop( - "Duplicate primary key values found in the dataset '", self$get_dataname(), "' :\n", - paste0(utils::capture.output(print(duplicates))[-c(1, 3)], collapse = "\n"), - call. = FALSE - ) - } - } - }, - #' @description - #' Derive the column names - #' @return `character` vector. - get_colnames = function() { - colnames(SummarizedExperiment::colData(private$.raw_data)) - }, - #' @description - #' Derive the column labels - #' @return `character` vector. - get_column_labels = function() { - vapply( - X = SummarizedExperiment::colData(private$.raw_data), - FUN.VALUE = character(1), - FUN = function(x) { - label <- attr(x, "label") - if (length(label) != 1) { - NA_character_ - } else { - label - } - } - ) - }, - #' @description - #' Get the number of columns of the data - #' @return `numeric` vector - get_ncol = function() { - ncol(SummarizedExperiment::colData(private$.raw_data)) - }, - #' @description - #' Get the number of rows of the data - #' @return `numeric` vector - get_nrow = function() { - nrow(SummarizedExperiment::colData(private$.raw_data)) - }, - #' @description - #' Derive the row names - #' @return `character` vector. - get_rownames = function() { - rownames(SummarizedExperiment::colData(private$.raw_data)) - }, - #' @description - #' Prints this `MAETealDataset`. - #' @param ... additional arguments to the printing method - #' - #' @return invisibly self - print = function(...) { - cat(sprintf("A MAETealDataset object containing data of %d subjects.\n", self$get_nrow())) - print(MultiAssayExperiment::experiments(self$get_raw_data())) - invisible(self) - } - ), - ## __Private Fields ==== - private = list( - .raw_data = NULL, - get_class_colnames = function(class_type = "character") { - checkmate::assert_string(class_type) - - return_cols <- private$.colnames[which(vapply( - lapply(SummarizedExperiment::colData(private$.raw_data), class), - function(x, target_class_name) any(x %in% target_class_name), - logical(1), - target_class_name = class_type - ))] - - return(return_cols) - }, - - # Evaluate script code to modify data or to reproduce data - # - # @param code (`CodeClass`) the object storing the code to execute - # @param vars (named `list`) additional pre-requisite vars to execute code - # @return (`environment`) which stores modified `x` - execute_code = function(code, vars = list()) { - stopifnot(inherits(code, "CodeClass")) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - execution_environment <- new.env(parent = parent.env(globalenv())) - - # set up environment for execution - for (vars_idx in seq_along(vars)) { - var_name <- names(vars)[[vars_idx]] - var_value <- vars[[vars_idx]] - if (inherits(var_value, "TealDatasetConnector") || inherits(var_value, "TealDataset")) { - var_value <- get_raw_data(var_value) - } - assign(envir = execution_environment, x = var_name, value = var_value) - } - - # execute - code$eval(envir = execution_environment) - - if (!inherits(execution_environment[[self$get_dataname()]], "MultiAssayExperiment")) { - out_msg <- sprintf( - "\n%s\n\n - Code from %s needs to return a MultiAssayExperiment assigned to an object of dataset name.", - self$get_code(), - self$get_dataname() - ) - - rlang::with_options( - .expr = stop(out_msg, call. = FALSE), - warning.length = max(min(8170, nchar(out_msg) + 30), 100) - ) - } - - new_set <- execution_environment[[self$get_dataname()]] - - return(new_set) - } - ) -) - -#' S3 method to construct an `MAETealDataset` object from `MultiAssayExperiment` -#' -#' @rdname dataset -#' -#' @examples -#' # Simple example -#' utils::data(miniACC, package = "MultiAssayExperiment") -#' mae_d <- dataset( -#' "MAE", -#' miniACC, -#' keys = c("STUDYID", "USUBJID"), -#' metadata = list(type = "example") -#' ) -#' mae_d$get_dataname() -#' mae_d$get_dataset_label() -#' mae_d$get_metadata() -#' mae_d$get_code() -#' mae_d$get_raw_data() -#' @export -dataset.MultiAssayExperiment <- function(dataname, # nolint - x, - keys = character(0), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL) { - if (!requireNamespace("MultiAssayExperiment", quietly = TRUE)) { - stop("Cannot load MultiAssayExperiment - please install the package or restart your session.") - } - checkmate::assert_string(dataname) - checkmate::assert( - checkmate::check_character(code, max.len = 1, any.missing = FALSE), - checkmate::check_class(code, "CodeClass") - ) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - MAETealDataset$new( - dataname = dataname, - x = x, - keys = keys, - code = code, - label = label, - vars = vars, - metadata = metadata - ) -} - -#' The constructor of `MAETealDataset` -#' -#' @description `r lifecycle::badge("deprecated")` -#' -#' @inheritParams dataset -#' @param x (`MultiAssayExperiment`) -#' -#' @examples -#' # Simple example -#' utils::data(miniACC, package = "MultiAssayExperiment") -#' mae_d <- dataset("MAE", miniACC) -#' mae_d$get_dataname() -#' mae_d$get_dataset_label() -#' mae_d$get_code() -#' mae_d$get_raw_data() -#' @export -mae_dataset <- function(dataname, - x, - label = data_label(x), - code = character(0), - vars = list()) { - lifecycle::deprecate_soft( - when = "0.10.1", - what = "teal.data::mae_dataset()", - with = "teal.data::dataset()" - ) - - if (!inherits(x, "MultiAssayExperiment")) { - stop("Argument x must be a MultiAssayExperiment object") - } - - dataset( - dataname = dataname, - x = x, - code = code, - label = label, - vars = vars - ) -} diff --git a/R/TealData.R b/R/TealData.R deleted file mode 100644 index eede288e3..000000000 --- a/R/TealData.R +++ /dev/null @@ -1,452 +0,0 @@ -## TealData ==== -#' @title Manage multiple `TealDataConnector`, `TealDatasetConnector` and `TealDataset` objects. -#' -#' @description `r lifecycle::badge("experimental")` -#' Class manages `TealDataConnector`, `TealDatasetConnector` and -#' `TealDataset` objects and aggregate them in one collection. -#' Class also decides whether to launch app before initialize teal application. -#' -#' @param ... (`TealDataConnector`, `TealDataset`, `TealDatasetConnector`)\cr -#' objects -#' @param join_keys (`JoinKeys`) or a single (`JoinKeySet`)\cr -#' (optional) object with dataset column relationships used for joining. -#' If empty then an empty `JoinKeys` object is passed by default. -#' @param check (`logical`) reproducibility check - whether evaluated preprocessing code gives the same objects -#' as provided in arguments. Check is run only if flag is true and preprocessing code is not empty. -#' -#' @examples -#' library(scda) -#' adsl_cf <- callable_function(function() synthetic_cdisc_data("latest")$adsl) -#' adlb_cf <- callable_function(function() synthetic_cdisc_data("latest")$adlb) -#' adrs_cf <- callable_function(function() synthetic_cdisc_data("latest")$adrs) -#' adtte_cf <- callable_function(function() synthetic_cdisc_data("latest")$adtte) -#' x1 <- cdisc_dataset_connector("ADSL", adsl_cf, keys = get_cdisc_keys("ADSL")) -#' x2 <- cdisc_dataset_connector("ADRS", adrs_cf, keys = get_cdisc_keys("ADRS")) -#' x3 <- cdisc_dataset( -#' dataname = "ADAE", -#' x = synthetic_cdisc_data("latest")$adae, -#' code = "library(scda)\nADAE <- synthetic_cdisc_data(\"latest\")$adae" -#' ) -#' x4 <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE")) -#' tc <- teal.data:::TealData$new(x1, x2, x3, x4) -#' tc$get_datanames() -#' \dontrun{ -#' tc$launch() -#' get_datasets(tc) # equivalent to tc$get_datasets() -#' tc$get_dataset("ADAE") -#' tc$check() -#' } -#' -#' x <- cdisc_dataset( -#' dataname = "ADSL", -#' x = synthetic_cdisc_data("latest")$adsl, -#' code = "library(scda)\nADSL <- synthetic_cdisc_data(\"latest\")$adsl" -#' ) -#' -#' x2 <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE")) -#' tc <- teal.data:::TealData$new(x, x2) -#' \dontrun{ -#' # This errors as we have not pulled the data -#' # tc$get_datasets() -#' # pull the data and then we can get the datasets -#' tc$launch() -#' tc$get_datasets() -#' get_raw_data(tc) -#' } -#' -TealData <- R6::R6Class( # nolint - classname = "TealData", - inherit = TealDataAbstract, - ## __Public Methods ==== - public = list( - #' @description - #' Create a new object of `TealData` class - initialize = function(..., check = FALSE, join_keys = teal.data::join_keys()) { - checkmate::assert_class(join_keys, "JoinKeys") - - dot_args <- list(...) - is_teal_data <- checkmate::test_list( - dot_args, - types = c("TealDataConnector", "TealDataset", "TealDatasetConnector") - ) - if (!all(is_teal_data)) { - stop("All elements should be of TealDataset(Connector) or TealDataConnector class") - } - - datanames <- unlist(lapply(dot_args, get_dataname)) - private$check_names(datanames) - - private$datasets <- dot_args - - self$set_check(check) - - private$pull_code <- CodeClass$new() - private$mutate_code <- CodeClass$new() - - private$join_keys <- join_keys - - self$id <- sample.int(1e11, 1, useHash = TRUE) - - logger::log_trace( - "TealData initialized with data: { paste(self$get_datanames(), collapse = ' ') }." - ) - return(invisible(self)) - }, - #' @description - #' Creates a copy of the object with keeping valid references - #' between `TealDataset` and `TealDatasetConnector` objects - #' @param deep (`logical(1)`)\cr - #' argument passed to `clone` method. If `TRUE` deep copy is made - #' @return self invisible - copy = function(deep = FALSE) { - new_self <- self$clone(deep = deep) - new_self$reassign_datasets_vars() - logger::log_trace("TealData$copy{if (deep) ' deep-' else ' '}copied self.") - invisible(new_self) - }, - #' @description - #' Prints this `TealData`. - #' - #' @param ... additional arguments to the printing method - #' @return invisibly self - print = function(...) { - check_ellipsis(...) - - cat(sprintf( - "A %s object containing %d TealDataset/TealDatasetConnector object(s) as element(s):\n", - class(self)[1], - length(private$datasets) - )) - - for (i in seq_along(private$datasets)) { - cat(sprintf("--> Element %d:\n", i)) - print(private$datasets[[i]]) - } - - invisible(self) - }, - # ___ getters ==== - #' @description - #' Get data connectors. - #' - #' @return (`list`) with all `TealDatasetConnector` or `TealDataConnector` objects. - get_connectors = function() { - return(Filter( - function(x) { - inherits(x, "TealDatasetConnector") || inherits(x, "TealDataConnector") - }, - private$datasets - )) - }, - #' @description - #' Get all datasets and all dataset connectors - #' - #' @param dataname (`character` value)\cr - #' name of dataset connector to be returned. If `NULL`, all connectors are returned. - #' - #' @return `list` with all datasets and all connectors - get_items = function(dataname = NULL) { - checkmate::assert_string(dataname, null.ok = TRUE) - - get_sets <- function(x) { - if (inherits(x, "TealDataConnector")) { - x$get_items() - } else { - x - } - } - - sets <- unlist(lapply(private$datasets, get_sets)) - names(sets) <- vapply(sets, get_dataname, character(1)) - - if (checkmate::test_string(dataname)) { - if (!(dataname %in% self$get_datanames())) { - stop(paste("dataset", dataname, "not found")) - } - return(sets[[dataname]]) - } else { - return(sets) - } - }, - - #' @description - #' Get join keys between two datasets. - #' - #' @param dataset_1 (`character`) name of first dataset. - #' @param dataset_2 (`character`) name of second dataset. - #' @return (`character`) named character vector x with names(x) the - #' columns of `dataset_1` and the values of `(x)` the corresponding join - #' keys in `dataset_2` or `character(0)` if no relationship - get_join_keys = function(dataset_1, dataset_2) { - if (missing(dataset_1) && missing(dataset_2)) { - private$join_keys - } else { - private$join_keys$get(dataset_1, dataset_2) - } - }, - - #' @description - #' returns the parents list of the datasets. - #' - #' @return named (`list`) of the parents of all datasets. - get_parents = function() { - private$join_keys$get_parents() - }, - - # ___ shiny ==== - - #' @description - #' - #' Get a shiny-module UI to render the necessary app to - #' derive `TealDataConnector` object's data - #' - #' @param id (`character`) item ID for the shiny module - #' @return the `shiny` `ui` function - get_ui = function(id) { - if (is.null(private$ui)) { - div(id = id, "Data Loaded") - } else { - private$ui(id) - } - }, - #' @description - #' - #' Get a shiny-module server to render the necessary app to - #' derive `TealDataConnector` object's data - #' - #' @return `shiny` server module. - get_server = function() { - if (is.null(private$server)) { - return( - function(id) { - moduleServer( - id = id, - module = function(input, output, session) { - reactive(self) - } - ) - } - ) - } else { - function(id) { - moduleServer( - id = id, - module = private$server - ) - } - } - }, - #' @description - #' - #' Launch an app that allows to run the user-interfaces of all - #' `TealDataConnector` and `TealDatasetConnector` modules - #' - #' This piece is mainly used for debugging. - launch = function() { - # if no data connectors can append any dataset connectors - # and not load an app - if (self$is_pulled()) { - stop("All the datasets have already been pulled.") - } - - # otherwise load TealDataConnector and - # TealDatasetConnector with shiny app - shinyApp( - ui = fluidPage( - theme = get_teal_bs_theme(), - fluidRow( - column( - width = 8, - offset = 2, - self$get_ui(id = "main_app"), - shinyjs::hidden( - tags$div( - id = "data_loaded", - div( - h3("Data successfully loaded."), - p("You can close this window and get back to R console.") - ) - ) - ), - include_js_files(), - br() - ) - ) - ), - server = function(input, output, session) { - session$onSessionEnded(stopApp) - dat <- self$get_server()(id = "main_app") - - observeEvent(dat(), { - if (self$is_pulled()) { - shinyjs::show("data_loaded") - stopApp() - } - }) - NULL - } - ) - }, - - # ___ mutate ==== - #' @description - #' Change join_keys for a given pair of dataset names - #' @param dataset_1,dataset_2 (`character`) datasets for which join_keys are to be returned - #' @param val (named `character`) column names used to join - #' @return (`self`) invisibly for chaining - mutate_join_keys = function(dataset_1, dataset_2, val) { - private$join_keys$mutate(dataset_1, dataset_2, val) - }, - - # ___ check ==== - #' @description - #' Check there is consistency between the datasets and join_keys - #' @return raise and error or invisible `TRUE` - check_metadata = function() { - if (isFALSE(self$is_pulled())) { - # all the checks below required data to be already pulled - return(invisible(TRUE)) - } - - for (dataset in self$get_datasets()) { - dataname <- get_dataname(dataset) - dataset_colnames <- dataset$get_colnames() - - # expected columns in this dataset from JoinKeys specification - join_key_cols <- unique(unlist(lapply(self$get_join_keys(dataname), names))) - if (!is.null(join_key_cols) && !all(join_key_cols %in% dataset_colnames)) { - stop( - paste( - "The join key specification requires dataset", - dataname, - "to contain the following columns:", - paste(join_key_cols, collapse = ", ") - ) - ) - } - - # check if primary keys in dataset - primary_key_cols <- self$get_join_keys(dataname, dataname) - if (!is.null(primary_key_cols) && !all(primary_key_cols %in% dataset_colnames)) { - stop( - paste( - "The primary keys specification requires dataset", - dataname, - "to contain the following columns:", - paste(primary_key_cols, collapse = ", ") - ) - ) - } - dataset$check_keys() - } - - logger::log_trace("TealData$check_metadata metadata check passed.") - - return(invisible(TRUE)) - } - ), - - ## __Private Fields ==== - private = list( - join_keys = NULL, - ui = function(id) { - ns <- NS(id) - - # connectors ui(s) + submit button - fluidPage( - include_js_files(), - theme = get_teal_bs_theme(), - shinyjs::hidden( - column( - id = ns("delayed_data"), - width = 8, - offset = 2, - div( - tagList( - lapply( - private$datasets, - function(x) { - div( - if (inherits(x, "TealDataConnector")) { - ui <- x$get_ui(id = ns(x$id)) - if (is.null(ui)) { - ui <- div( - h4("TealDataset Connector for: ", lapply(x$get_datanames(), code)), - p(icon("check"), "Ready to Load") - ) - } - ui - } else if (inherits(x, "TealDatasetConnector")) { - ui <- x$get_ui(id = ns(paste0(x$get_datanames(), collapse = "_"))) - if (is.null(ui)) { - ui <- div( - h4("TealDataset Connector for: ", code(x$get_dataname())), - p(icon("check"), "Ready to Load") - ) - } - ui - } else { - div(h4("Data(set) for: ", lapply(x$get_datanames(), code)), p(icon("check"), "Loaded")) - }, - br() - ) - } - ), - actionButton(inputId = ns("submit"), label = "Submit all") - ), - `data-proxy-click` = ns("submit") # handled by jscode in custom.js - hit enter to submit - ) - ) - ) - ) - }, - server = function(input, output, session) { - logger::log_trace("TealData$server initializing...") - - shinyjs::show("delayed_data") - for (dc in self$get_connectors()) { - if (inherits(dc, "TealDataConnector")) { - dc$get_preopen_server()(id = dc$id) - } - } - rv <- reactiveVal(NULL) - observeEvent(input$submit, { - logger::log_trace("TealData$server@1 submit button clicked.") - # load data from all connectors - for (dc in self$get_connectors()) { - if (inherits(dc, "TealDataConnector")) { - dc$get_server()( - id = dc$id, - connection = dc$get_connection(), - connectors = dc$get_items() - ) - } else if (inherits(dc, "TealDatasetConnector")) { - dc$get_server()(id = dc$get_dataname()) - } - if (dc$is_failed()) { - break - } - } - - if (self$is_pulled()) { - logger::log_trace("TealData$server@1 data is pulled.") - withProgress(value = 1, message = "Checking data reproducibility", { - # We check first and then mutate. - # mutate_code is reproducible by default we assume that we don't - # have to check the result of the re-evaluation of the code - self$check_reproducibility() - }) - - withProgress(value = 1, message = "Executing processing code", { - self$execute_mutate() - self$check_metadata() - }) - logger::log_info("Data ready to pass to the application.") - shinyjs::hide("delayed_data") - rv(self) - } - }) - return(rv) - } - ) -) diff --git a/R/TealDataAbstract.R b/R/TealDataAbstract.R deleted file mode 100644 index 18f905dfd..000000000 --- a/R/TealDataAbstract.R +++ /dev/null @@ -1,491 +0,0 @@ -## TealDataAbstract ==== -#' @title `TealDataAbstract` class -#' -#' @description -#' Abstract class containing code for handling set of datasets. -#' @keywords internal -TealDataAbstract <- R6::R6Class( # nolint - classname = "TealDataAbstract", - ## __Public Methods ==== - public = list( - #' @description - #' Cannot create a `TealDataAbstract` object - #' - #' @return throws error - initialize = function() { - stop("Pure virtual method") - }, - #' @description - #' Check if the object raw data is reproducible from the `get_code()` code. - #' @return - #' `NULL` if check step has been disabled - #' `TRUE` if all the datasets generated from evaluating the - #' `get_code()` code are identical to the raw data, else `FALSE`. - check = function() { - # code can be put only to the mutate with empty code in datasets - res <- if (isFALSE(private$.check)) { - NULL - } else { - if (length(private$pull_code$code) > 0) { - private$check_combined_code() - } else { - all(vapply( - private$datasets, - function(x) { - check_res <- x$check() - # NULL is still ok - is.null(check_res) || isTRUE(check_res) - }, - logical(1) - )) - } - } - private$check_result <- res - logger::log_trace("TealDataAbstract$check executed the code to reproduce the data - result: { res }.") - res - }, - #' @description - #' Execute `check()` and raise an error if it's not reproducible. - #' @return error if code is not reproducible else invisibly nothing - check_reproducibility = function() { - self$check() - if (isFALSE(self$get_check_result())) { - stop("Reproducibility check failed.") - } - logger::log_trace("TealDataAbstract$check_reproducibility reproducibility check passed.") - return(invisible(NULL)) - }, - #' @description - #' Execute mutate code. Using `mutate_data(set).TealDataAbstract` - #' does not cause instant execution, the `mutate_code` is - #' delayed and can be evaluated using this method. - execute_mutate = function() { - logger::log_trace("TealDataAbstract$execute_mutate evaluating mutate code...") - # this will be pulled already! - not needed? - if (length(private$mutate_code$code) == 0) { - res <- unlist(lapply( - private$datasets, - function(x) { - if (is_pulled(x)) { - get_datasets(x) - } else { - NULL - } - } - )) - # exit early if mutate isn't required - logger::log_trace("TealDataAbstract$execute_mutate no code to evaluate.") - if (!is.null(res)) { - res <- stats::setNames(res, vapply(res, get_dataname, character(1))) - } - return(res) - } - - if (inherits(private$mutate_code, "PythonCodeClass")) { - items <- lapply(self$get_items(), get_raw_data) - datasets <- stats::setNames(items, vapply(self$get_items(), get_dataname, character(1))) - - new_env <- private$mutate_code$eval(vars = c(datasets, private$mutate_vars)) - } else { - # have to evaluate post-processing code (i.e. private$mutate_code) before returning dataset - new_env <- new.env(parent = parent.env(globalenv())) - for (dataset in self$get_items()) { - assign(get_dataname(dataset), get_raw_data(dataset), envir = new_env) - } - - for (var_idx in seq_along(private$mutate_vars)) { - mutate_var <- private$mutate_vars[[var_idx]] - assign( - x = names(private$mutate_vars)[[var_idx]], - value = `if`( - inherits(mutate_var, "TealDataset") || inherits(mutate_var, "TealDatasetConnector"), - get_raw_data(mutate_var), - mutate_var - ), - envir = new_env - ) - } - - private$mutate_code$eval(envir = new_env) - } - - lapply( - self$get_datasets(), - function(x) { - x$recreate( - x = get(get_dataname(x), new_env) - ) - } - ) - logger::log_trace("TealDataAbstract$execute_mutate evaluated mutate code.") - return(invisible(NULL)) - }, - #' @description - #' Get result of reproducibility check - #' @return `NULL` if check has not been called yet, `TRUE` / `FALSE` otherwise - get_check_result = function() { - private$check_result - }, - #' @description - #' Get code for all datasets. - #' @param dataname (`character`) dataname or `NULL` for all datasets - #' @param deparse (`logical`) whether to return the deparsed form of a call - #' @return (`character`) vector of code to generate datasets. - get_code = function(dataname = NULL, deparse = TRUE) { - checkmate::assert_character(dataname, min.len = 1, null.ok = TRUE, any.missing = FALSE) - checkmate::assert_flag(deparse) - - return(self$get_code_class()$get_code(dataname = dataname, deparse = deparse)) - }, - #' @description - #' Get internal `CodeClass` object - #' @param only_pull (`logical` value)\cr - #' if `TRUE` only code to pull datasets will be returned without the mutate code. - #' - #' @return `CodeClass` - get_code_class = function(only_pull = FALSE) { - all_code_class <- CodeClass$new() - - pull_code_class <- private$get_pull_code_class() - all_code_class$append(pull_code_class) - - datasets_code_class <- private$get_datasets_code_class() - all_code_class$append(datasets_code_class) - - if (isFALSE(only_pull)) { - mutate_code_class <- private$get_mutate_code_class() - all_code_class$append(mutate_code_class) - } - - return(all_code_class) - }, - #' @description - #' Get names of the datasets. - #' - #' @return `character` vector with names of all datasets. - get_datanames = function() { - datasets_names <- unname(unlist(lapply(private$datasets, get_dataname))) - - return(datasets_names) - }, - #' @description - #' Get `TealDataset` object. - #' - #' @param dataname (`character` value)\cr - #' name of dataset to be returned. If `NULL`, all datasets are returned. - #' - #' @return `TealDataset`. - get_dataset = function(dataname = NULL) { - checkmate::assert_string(dataname, null.ok = TRUE) - - if (length(dataname) == 1) { - if (!(dataname %in% self$get_datanames())) { - stop(paste("dataset", dataname, "not found")) - } - - res <- self$get_datasets()[[dataname]] - return(res) - } else { - return(self$get_datasets()) - } - }, - #' @description - #' Get `list` of `TealDataset` objects. - #' - #' @return `list` of `TealDataset`. - get_datasets = function() { - if (!self$is_pulled()) { - stop( - "Not all datasets have been pulled yet.\n", - "- Please use `load_datasets()` to retrieve complete results." - ) - } - unlist(lapply(self$get_items(), get_dataset)) - }, - #' @description - #' Get all datasets and all dataset connectors - #' - #' @param dataname (`character` value)\cr - #' name of dataset connector to be returned. If `NULL`, all connectors are returned. - #' @return `list` with all datasets and all connectors - get_items = function(dataname = NULL) { - checkmate::assert_string(dataname, null.ok = TRUE) - - if (length(dataname) == 1) { - if (!(dataname %in% self$get_datanames())) { - stop(paste("dataset", dataname, "not found")) - } - return(private$datasets[[dataname]]) - } else { - return(private$datasets) - } - }, - #' @description - #' Has this data been or will this data be subjected to a reproducibility check - #' @return `logical` - get_check = function() { - private$.check - }, - #' @field id String used to create unique GUI elements - id = NULL, - #' @description - #' Check if dataset has already been pulled. - #' - #' @return `TRUE` if dataset has been already pulled, else `FALSE` - is_pulled = function() { - all(vapply(private$datasets, is_pulled, logical(1))) - }, - #' @description - #' Mutate data by code. Code used in this mutation is not linked to particular - #' but refers to all datasets. - #' Consequence of this is that when using `get_code()` this - #' part of the code will be returned for each specified dataset. This method - #' should be used only if particular call involve changing multiple datasets. - #' Otherwise please use `mutate_dataset`. - #' Execution of `mutate_code` is delayed after datasets are pulled - #' (`isTRUE(is_pulled)`). - #' - #' @param code (`character`) Code to mutate the dataset. Must contain the - #' `dataset$dataname` - #' @param vars (named `list`)) \cr - #' In case when this object code depends on other `TealDataset` object(s) or - #' other constant value, this/these object(s) should be included as named - #' element(s) of the list. For example if this object code needs `ADSL` - #' object we should specify `vars = list(ADSL = )`. - #' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to - #' the `vars` list to preserve reproducibility. Please note that `vars` - #' are included to this object as local `vars` and they cannot be modified - #' within another dataset. - #' - #' @return self invisibly for chaining - mutate = function(code, vars = list()) { - private$set_mutate_vars(vars) - private$set_mutate_code( - code = code, - deps = names(vars) - ) - private$check_result <- NULL - logger::log_trace( - sprintf( - "TealDataAbstract$mutate code (%s lines) and vars (%s) set.", - length(parse(text = code, keep.source = FALSE)), - paste(names(vars), collapse = ", ") - ) - ) - return(invisible(self)) - }, - #' @description - #' Mutate dataset by code. - #' Execution of `mutate_code` is delayed after datasets are pulled - #' (`isTRUE(is_pulled)`). - #' - #' @param dataname (`character`) Dataname to be mutated - #' @param code (`character`) Code to mutate the dataset. Must contain the - #' `dataset$dataname` - #' @param vars (named `list`)) \cr - #' In case when this object code depends on other `TealDataset` object(s) or - #' other constant value, this/these object(s) should be included as named - #' element(s) of the list. For example if this object code needs `ADSL` - #' object we should specify `vars = list(ADSL = )`. - #' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to - #' the `vars` list to preserve reproducibility. Please note that `vars` - #' are included to this object as local `vars` and they cannot be modified - #' within another dataset. - #' - #' @return self invisibly for chaining - mutate_dataset = function(dataname, code, vars = list()) { - checkmate::assert_character(dataname, min.len = 1, any.missing = FALSE) - stopifnot(all(dataname %in% self$get_datanames())) - - private$set_mutate_vars(vars = vars) - private$set_mutate_code( - code = code, - dataname = dataname, - deps = names(vars) - ) - - private$check_result <- NULL - logger::log_trace( - sprintf( - "TealDataAbstract$mutate code (%s lines) and vars (%s) set for dataset: %s.", - length(parse(text = code, keep.source = FALSE)), - paste(names(vars), collapse = ", "), - dataname - ) - ) - - return(invisible(self)) - }, - #' @description - #' Set reproducibility check - #' - #' @param check (`logical`) whether to perform reproducibility check. - #' - #' @return (`self`) invisibly for chaining. - set_check = function(check = FALSE) { - checkmate::assert_flag(check) - private$.check <- check - logger::log_trace("TealDataAbstract$set_check check set to: { check }.") - return(invisible(self)) - }, - #' @description - #' Set pull code - #' - #' @param code (`character` value)\cr - #' code to reproduce `data` in `TealDataset` objects. Can't be set if any dataset - #' has `code` set already. - #' - #' @return (`self`) invisibly for chaining. - set_pull_code = function(code) { - checkmate::assert_string(code) - is_code_set <- vapply( - self$get_items(), - function(item) { - get_code(item, deparse = TRUE) != "" - }, - logical(1) - ) - - is_dataset <- vapply( - self$get_items(), - function(item) { - inherits(item, "TealDataset") - }, - logical(1) - ) - - if (any(is_code_set & is_dataset)) { - stop( - "'code' argument should be specified only in the 'cdisc_data' or in 'cdisc_dataset' but not in both", - call. = FALSE - ) - } - - if (all(!is_dataset)) { - stop( - "Connectors are reproducible by default and setting 'code' argument might break it", - call. = FALSE - ) - } - - private$pull_code <- private$pull_code$set_code( - code = code, - dataname = self$get_datanames() - ) - logger::log_trace("TealDataAbstract$set_pull_code pull code set.") - - return(invisible(self)) - }, - - #' @description - #' Reassign `vars` in `TealDataset` and `TealDatasetConnector` objects - #' to keep the valid reference after deep cloning - #' For example if `TealDatasetConnector` has a dependency on some `TealDataset`, this - #' `TealDataset` is reassigned inside of `TealDatasetConnector`. - reassign_datasets_vars = function() { - for (dataset in self$get_items()) { - dataset$reassign_datasets_vars( - datasets = self$get_items() - ) - } - logger::log_trace("TealDataAbstract$reassign_datasets_vars reassigned vars.") - invisible(NULL) - } - ), - - ## __Private Fields ==== - private = list( - datasets = NULL, - .check = FALSE, - check_result = NULL, # TRUE / FALSE after calling check() - mutate_code = NULL, # CodeClass after initialization - mutate_vars = list(), # named list with vars used to mutate object - pull_code = NULL, # CodeClass - code to reproduce loading of TealDataset(s) only - - ## __Private Methods ==== - # need to have a custom deep_clone because one of the key fields are reference-type object - # in particular: datasets is a list of R6 objects that wouldn't be cloned using default clone(deep = T) - deep_clone = function(name, value) { - deep_clone_r6(name, value) - }, - check_combined_code = function() { - execution_environment <- new.env(parent = parent.env(globalenv())) - self$get_code_class(only_pull = TRUE)$eval(envir = execution_environment) - res <- all(vapply( - Filter(is_pulled, self$get_items()), - function(dataset) { - data <- get_raw_data(dataset) - data_from_code <- get(get_dataname(dataset), execution_environment) - identical(data, data_from_code) - }, - logical(1) - )) - logger::log_trace("TealDataAbstract$check_combined_code reproducibility result of the combined code: { res }.") - res - }, - get_datasets_code_class = function() { - res <- CodeClass$new() - if (is.null(private$datasets)) { - return(res) - } - for (dataset in private$datasets) { - res$append(dataset$get_code_class()) - } - return(res) - }, - get_mutate_code_class = function() { - res <- CodeClass$new() - res$append(list_to_code_class(private$mutate_vars)) - res$append(private$mutate_code) - return(res) - }, - get_pull_code_class = function() { - res <- CodeClass$new() - res$append(private$pull_code) - return(res) - }, - set_mutate_code = function(code, dataname = self$get_datanames(), deps = names(private$mutate_vars)) { - checkmate::assert( - checkmate::check_character(code, max.len = 1, any.missing = FALSE), - checkmate::check_class(code, "PythonCodeClass") - ) - - if (inherits(code, "PythonCodeClass")) { - r <- PythonCodeClass$new() - r$append(private$mutate_code) - private$mutate_code <- r - - code <- code$get_code() - } - - if (length(code) > 0 && code != "") { - private$mutate_code$set_code(code = code, dataname = dataname, deps = deps) - } - - return(invisible(self)) - }, - set_mutate_vars = function(vars) { - checkmate::assert_list(vars, min.len = 0, names = "unique") - if (length(vars) > 0) { - private$mutate_vars <- c( - private$mutate_vars, - vars[!names(vars) %in% names(private$mutate_vars)] - ) - } - - return(invisible(self)) - }, - check_names = function(x) { - if (any(vapply(x, identical, logical(1), y = ""))) { - stop("Cannot extract some dataset names") - } - if (any(duplicated(x))) { - stop("TealDatasets names should be unique") - } - if (any(x %in% self$get_datanames())) { - stop("Some datanames already exists") - } - return(TRUE) - } - ) -) diff --git a/R/TealDataConnection.R b/R/TealDataConnection.R deleted file mode 100644 index 9d1b69dac..000000000 --- a/R/TealDataConnection.R +++ /dev/null @@ -1,723 +0,0 @@ -## TealDataConnection ==== -#' @title A `TealDataConnection` class of objects -#' @description `r lifecycle::badge("stable")` -#' -#' Objects of this class store the connection to a data source. -#' It can be a database or server connection. -#' -#' @examples -#' open_fun <- callable_function(data.frame) # define opening function -#' open_fun$set_args(list(x = 1:5)) # define fixed arguments to opening function -#' -#' close_fun <- callable_function(sum) # define closing function -#' close_fun$set_args(list(x = 1:5)) # define fixed arguments to closing function -#' -#' ping_fun <- callable_function(function() TRUE) -#' -#' x <- data_connection( # define connection -#' ping_fun = ping_fun, # define ping function -#' open_fun = open_fun, # define opening function -#' close_fun = close_fun # define closing function -#' ) -#' -#' x$set_open_args(args = list(y = letters[1:5])) # define additional arguments if necessary -#' -#' x$open() # call opening function -#' x$get_open_call() # check reproducible R code -#' -#' # get data from connection via TealDataConnector$get_dataset() -#' \dontrun{ -#' x$open(args = list(x = 1:5, y = letters[1:5])) # able to call opening function with arguments -#' x$close() # call closing function -#' } -#' -TealDataConnection <- R6::R6Class( # nolint - ## __Public Methods ==== - "TealDataConnection", - public = list( - #' @description - #' Create a new `TealDataConnection` object - #' - #' @param open_fun (`CallableFunction`) function to open connection - #' @param close_fun (`CallableFunction`) function to close connection - #' @param ping_fun (`CallableFunction`) function to ping connection - #' @param if_conn_obj optional, (`logical`) whether to store `conn` object returned from opening - #' connection - #' @return new `TealDataConnection` object - initialize = function(open_fun = NULL, close_fun = NULL, ping_fun = NULL, if_conn_obj = FALSE) { - checkmate::assert_flag(if_conn_obj) - if (!is.null(open_fun)) { - stopifnot(inherits(open_fun, "Callable")) - private$set_open_fun(open_fun) - } - if (!is.null(close_fun)) { - stopifnot(inherits(close_fun, "Callable")) - private$set_close_fun(close_fun) - } - if (!is.null(ping_fun)) { - stopifnot(inherits(ping_fun, "Callable")) - private$set_ping_fun(ping_fun) - } - private$if_conn_obj <- if_conn_obj - - private$open_ui <- function(id) { - NULL - } - private$ping_ui <- function(id) { - NULL - } - private$close_ui <- function(id) { - NULL - } - - logger::log_trace( - sprintf( - "TealDataConnection initialized with:%s%s%s%s.", - if (!is.null(open_fun)) " open_fun" else "", - if (!is.null(close_fun)) " close_fun" else "", - if (!is.null(ping_fun)) " ping_fun" else "", - if (if_conn_obj) " conn" else "" - ) - ) - invisible(self) - }, - #' @description - #' Finalize method closing the connection. - #' - #' @return NULL - finalize = function() { - self$close(silent = TRUE, try = TRUE) - NULL - }, - #' @description - #' If connection is opened - #' - #' If open connection has been successfully evaluated - #' - #' @return (`logical`) if connection is open - is_opened = function() { - return(private$opened) - }, - #' @description - #' Check if connection has not failed. - #' - #' @return (`logical`) `TRUE` if connection failed, else `FALSE` - is_failed = function() { - self$is_open_failed() || self$is_close_failed() - }, - #' @description - #' Run simple application that uses its `ui` and `server` fields to open the - #' connection. - #' - #' Useful for debugging - #' - #' @return An object that represents the app - launch = function() { - shinyApp( - ui = fluidPage( - include_js_files(), - theme = get_teal_bs_theme(), - fluidRow( - column( - width = 8, - offset = 2, - tags$div( - id = "connection_inputs", - self$get_open_ui(id = "data_connection"), - actionButton("submit", "Submit"), - `data-proxy-click` = "submit" # handled by jscode in custom.js - hit enter to submit - ), - shinyjs::hidden( - tags$div( - id = "connection_set", - div( - h3("Connection successfully set."), - p("You can close this window and get back to R console.") - ) - ) - ) - ) - ) - ), - server = function(input, output, session) { - session$onSessionEnded(stopApp) - preopen_server <- self$get_preopen_server() - if (!is.null(preopen_server)) { - preopen_server(id = "data_connection", connection = self) - } - observeEvent(input$submit, { - rv <- reactiveVal(NULL) - open_server <- self$get_open_server() - if (!is.null(open_server)) { - rv(open_server(id = "data_connection", connection = self)) - } - observeEvent(rv(), { - if (self$is_opened()) { - removeUI(sprintf("#%s", session$ns("connection_inputs"))) - shinyjs::show("connection_set") - stopApp() - } - }) - }) - } - ) - }, - # ___ open connection ----- - #' @description - #' Open the connection. - #' - #' Note that if the connection is already opened then it does nothing. - #' - #' @param args (`NULL` or named `list`) additional arguments not set up previously - #' @param silent (`logical`) whether convert all "missing function" errors to messages - #' @param try (`logical`) whether perform function evaluation inside `try` clause - #' - #' @return returns `self` if successful or if connection has been already - #' opened. If `open_fun` fails, app returns an error in form of - #' `shinyjs::alert` (if `try = TRUE`) or breaks the app (if `try = FALSE`) - #' - open = function(args = NULL, silent = FALSE, try = FALSE) { - logger::log_trace("TealDataConnection$open opening the connection...") - checkmate::assert_list(args, min.len = 0, names = "unique", null.ok = TRUE) - if (isFALSE(private$check_open_fun(silent = silent))) { - return() - } - if (isTRUE(private$opened) && isTRUE(private$ping())) { - private$opened <- TRUE - logger::log_trace("TealDataConnection$open connection already opened - skipped.") - return(invisible(self)) - } else { - open_res <- private$open_fun$run(args = args, try = try) - if (!self$is_open_failed()) { - private$opened <- TRUE - if (private$if_conn_obj && !is.null(open_res)) { - private$conn <- open_res - - if (!is.null(private$close_fun)) { - private$close_fun$assign_to_env("conn", private$conn) - } - if (!is.null(private$ping_fun)) { - private$ping_fun$assign_to_env("conn", private$conn) - } - } - logger::log_trace("TealDataConnection$open connection opened.") - } else { - private$opened <- FALSE - private$conn <- NULL - logger::log_error("TealDataConnection$open connection failed to open.") - } - - return(invisible(self)) - } - }, - - #' @description - #' Get internal connection object - #' - #' @return `connection` object - get_conn = function() { - return(private$conn) - }, - #' @description - #' Get executed open connection call - #' - #' @param deparse (`logical`) whether return deparsed form of a call - #' @param args (`NULL` or named `list`) additional arguments not set up previously - #' @param silent (`logical`) whether convert all "missing function" errors to messages - #' - #' @return optionally deparsed `call` object - get_open_call = function(deparse = TRUE, args = NULL, silent = FALSE) { - checkmate::assert_flag(deparse) - checkmate::assert_list(args, min.len = 0, names = "unique", null.ok = TRUE) - if (isFALSE(private$check_open_fun(silent = silent))) { - return() - } - open_call <- private$open_fun$get_call(deparse = FALSE, args = args) - - if (private$if_conn_obj) { - open_call <- call("<-", as.name("conn"), open_call) - } - - if (isTRUE(deparse)) { - deparse1(open_call, collapse = "\n") - } else { - open_call - } - }, - #' @description - #' Get error message from last connection - #' - #' @return (`character`)\cr - #' text of the error message or `character(0)` if last - #' connection was successful. - get_open_error_message = function() { - return(private$open_fun$get_error_message()) - }, - #' @description - #' Get shiny server module prior opening connection. - #' - #' @return (`function`) shiny server prior opening connection. - get_preopen_server = function() { - return(private$preopen_server) - }, - #' @description - #' Get shiny server module to open connection. - #' - #' @return (`function`) shiny server to open connection. - get_open_server = function() { - return(private$open_server) - }, - #' @description - #' Get Shiny module with inputs to open connection - #' - #' @param id `character` shiny element id - #' - #' @return (`function`) shiny ui to set arguments to open connection function. - get_open_ui = function(id) { - return(private$open_ui(id)) - }, - #' @description - #' Check if open connection has not failed. - #' - #' @return (`logical`) `TRUE` if open connection failed, else `FALSE` - is_open_failed = function() { - if (!is.null(private$open_fun)) { - private$open_fun$is_failed() - } else { - FALSE - } - }, - #' @description - #' Set open connection function argument - #' - #' @param args (`NULL` or named `list`) with values where list names are argument names - #' @param silent (`logical`) whether convert all "missing function" errors to messages - #' - #' @return (`self`) invisibly for chaining. - set_open_args = function(args, silent = FALSE) { - checkmate::assert_list(args, min.len = 0, names = "unique", null.ok = TRUE) - if (isFALSE(private$check_open_fun(silent = silent))) { - return() - } - private$open_fun$set_args(args) - logger::log_trace("TealDataConnection$set_open_args open args set.") - - return(invisible(self)) - }, - #' @description - #' Set pre-open connection server function - #' - #' This function will be called before submit button will be hit. - #' - #' @param preopen_module (`function`)\cr - #' A shiny module server function - #' - #' @return (`self`) invisibly for chaining. - set_preopen_server = function(preopen_module) { - stopifnot(inherits(preopen_module, "function")) - module_name <- "open_conn" - if (all(names(formals(preopen_module)) %in% c("input", "output", "session", "connection"))) { - private$preopen_server <- function(input, output, session, connection) { - callModule(preopen_module, id = module_name, connection = connection) - } - } else if (all(names(formals(preopen_module)) %in% c("id", "connection"))) { - private$preopen_server <- function(id, connection) { - moduleServer( - id = id, - module = function(input, output, session) { - preopen_module(id = module_name, connection = connection) - } - ) - } - } else { - stop(paste( - "set_preopen_server accepts only a valid shiny module", - "definition with a single additional parameter 'connection'." - )) - } - logger::log_trace("TealDataConnection$set_preopen_server preopen_server set.") - - invisible(self) - }, - #' @description - #' Set open connection server function - #' - #' This function will be called after submit button will be hit. There is no possibility to - #' specify some dynamic `ui` as `server` function is executed after hitting submit - #' button. - #' - #' @param open_module (`function`)\cr - #' A shiny module server function that should load data from all connectors - #' - #' @return (`self`) invisibly for chaining. - set_open_server = function(open_module) { - stopifnot(inherits(open_module, "function")) - module_name <- "open_conn" - if (all(names(formals(open_module)) %in% c("input", "output", "session", "connection"))) { - private$open_server <- function(input, output, session, connection) { - withProgress(message = "Opening connection", value = 1, { - callModule(open_module, id = module_name, connection = connection) - }) - } - } else if (all(names(formals(open_module)) %in% c("id", "connection"))) { - private$open_server <- function(id, connection) { - moduleServer( - id = id, - module = function(input, output, session) { - withProgress(message = "Opening connection", value = 1, { - open_module(id = module_name, connection = connection) - }) - } - ) - } - } else { - stop(paste( - "set_open_server accepts only a valid shiny module", - "definition with a single additional parameter 'connection'." - )) - } - logger::log_trace("TealDataConnection$set_open_server open_server set.") - - invisible(self) - }, - #' @description - #' Set open connection UI function - #' - #' @param open_module (`function`)\cr - #' shiny module as function. Inputs specified in this `ui` are passed to server module - #' defined by `set_open_server` method. - #' - #' @return (`self`) invisibly for chaining. - set_open_ui = function(open_module) { - stopifnot(inherits(open_module, "function")) - stopifnot(identical(names(formals(open_module)), "id")) - - private$open_ui <- function(id) { - ns <- NS(id) - tags$div( - tags$div( - id = ns("open_conn"), - open_module(id = ns("open_conn")) - ) - ) - } - logger::log_trace("TealDataConnection$set_open_ui open_ui set.") - - invisible(self) - }, - # ___ close connection ------- - #' @description - #' Close the connection. - #' - #' @param silent (`logical`) whether convert all "missing function" errors to messages - #' @param try (`logical`) whether perform function evaluation inside `try` clause - #' - #' @return returns (`self`) if successful. For unsuccessful evaluation it - #' depends on `try` argument: if `try = TRUE` then returns - #' `error`, for `try = FALSE` otherwise - close = function(silent = FALSE, try = FALSE) { - logger::log_trace("TealDataConnection$close closing the connection...") - if (isFALSE(private$check_close_fun(silent = silent))) { - return() - } - close_res <- private$close_fun$run(try = try) - if (inherits(close_res, "error")) { - logger::log_error("TealDataConnection$close failed to close the connection.") - return(close_res) - } else { - private$opened <- FALSE - private$conn <- NULL - logger::log_trace("TealDataConnection$close connection closed.") - return(invisible(NULL)) - } - }, - #' @description - #' Get executed close connection call - #' - #' @param deparse (`logical`) whether return deparsed form of a call - #' @param silent (`logical`) whether convert all "missing function" errors to messages - #' - #' @return optionally deparsed `call` object - get_close_call = function(deparse = TRUE, silent = FALSE) { - checkmate::assert_flag(deparse) - if (isFALSE(private$check_close_fun(silent = silent))) { - return() - } - private$close_fun$get_call(deparse = deparse) - }, - #' @description - #' Get error message from last connection - #' - #' @return (`character`)\cr - #' text of the error message or `character(0)` if last - #' connection was successful. - get_close_error_message = function() { - return(private$close_fun$get_error_message()) - }, - #' @description - #' Get shiny server module to close connection. - #' - #' @return the `server function` to close connection. - get_close_server = function() { - return(private$close_server) - }, - #' @description - #' Check if close connection has not failed. - #' - #' @return (`logical`) `TRUE` if close connection failed, else `FALSE` - is_close_failed = function() { - if (!is.null(private$close_fun)) { - private$close_fun$is_failed() - } else { - FALSE - } - }, - - #' @description - #' Set close connection function argument - #' - #' @param args (named `list`) with values where list names are argument names - #' @param silent (`logical`) whether convert all "missing function" errors to messages - #' - #' @return (`self`) invisibly for chaining. - set_close_args = function(args, silent = FALSE) { - checkmate::assert_list(args, min.len = 0, names = "unique", null.ok = TRUE) - if (isFalse(private$check_close_fun(silent = silent))) { - return() - } - private$close_fun$set_args(args) - logger::log_trace("TealDataConnection$set_close_args close_args set") - - return(invisible(self)) - }, - - #' @description - #' Set close connection UI function - #' - #' @param close_module (`function`)\cr - #' shiny module as function. Inputs specified in this `ui` are passed to server module - #' defined by `set_close_server` method. - #' - #' @return (`self`) invisibly for chaining. - set_close_ui = function(close_module) { - stopifnot(inherits(close_module, "function")) - stopifnot(identical(names(formals(close_module)), "id")) - - private$close_ui <- function(id) { - ns <- NS(id) - tags$div( - tags$div( - id = ns("close_conn"), - close_module(id = ns("close_conn")) - ) - ) - } - logger::log_trace("TealDataConnection$close_ui close_ui set.") - - return(invisible(self)) - }, - - #' @description - #' Set close-connection server function - #' - #' This function will be called after submit button will be hit. There is no possibility to - #' specify some dynamic `ui` as `server` function is executed after hitting submit - #' button. - #' - #' @param close_module (`function`)\cr - #' A shiny module server function that should load data from all connectors - #' - #' @return (`self`) invisibly for chaining. - set_close_server = function(close_module) { - stopifnot(inherits(close_module, "function")) - if (all(names(formals(close_module)) %in% c("input", "output", "session", "connection"))) { - function(input, output, session, connection) { - connection$close(try = TRUE) - - if (connection$is_close_failed()) { - shinyjs::alert( - paste( - "Error closing connection\nError message: ", - connection$get_close_error_message() - ) - ) - } - invisible(connection) - } - } else if (all(names(formals(close_module)) %in% c("id", "connection"))) { - function(id, connection) { - moduleServer( - id, - function(input, output, session) { - connection$close(try = TRUE) - - if (connection$is_close_failed()) { - shinyjs::alert( - paste( - "Error closing connection\nError message: ", - connection$get_close_error_message() - ) - ) - } - invisible(connection) - } - ) - } - } else { - stop(paste( - "set_close_server accepts only a valid shiny module", - "definition with a single additional parameter 'connection'." - )) - } - logger::log_trace("TealDataConnection$set_close_server close_server set.") - - invisible(self) - } - ), - ## __Private Fields ==== - private = list( - # callableFunctions - open_fun = NULL, - close_fun = NULL, - ping_fun = NULL, - - # connection object - if_conn_obj = FALSE, - conn = NULL, - - # shiny elements - open_ui = NULL, - close_ui = NULL, - ping_ui = NULL, - preopen_server = NULL, - open_server = NULL, - close_server = NULL, - ping_server = NULL, - opened = FALSE, - - ## __Private Methods ==== - # need to have a custom deep_clone because one of the key fields are reference-type object - # in particular: open_fun is a R6 object that wouldn't be cloned using default clone(deep = T) - deep_clone = function(name, value) { - deep_clone_r6(name, value) - }, - check_open_fun = function(silent = FALSE) { - checkmate::assert_flag(silent) - - if (is.null(private$open_fun)) { - msg <- "Open connection function not set" - if (silent) { - return(FALSE) - } else { - stop(msg) - } - } else { - return(TRUE) - } - }, - check_close_fun = function(silent = FALSE) { - checkmate::assert_flag(silent) - - if (is.null(private$close_fun)) { - msg <- "Close connection function not set" - if (silent) { - return(FALSE) - } else { - stop(msg) - } - } else { - return(TRUE) - } - }, - # @description - # Set close connection function - # - # @param fun (`Callable`) function to close connection - # - # @return (`self`) invisibly for chaining. - set_close_fun = function(fun) { - stopifnot(inherits(fun, "Callable")) - private$close_fun <- fun - return(invisible(self)) - }, - # @description - # Set open connection function - # - # @param fun (`Callable`) function to open connection - # - # @return (`self`) invisibly for chaining. - set_open_fun = function(fun) { - stopifnot(inherits(fun, "Callable")) - private$open_fun <- fun - return(invisible(self)) - }, - # @description - # Set a ping function - # - # @param fun (`Callable`) function to ping connection - # - # @return (`self`) invisibly for chaining. - set_ping_fun = function(fun) { - stopifnot(inherits(fun, "Callable")) - private$ping_fun <- fun - return(invisible(self)) - }, - # @description - # Ping the connection. - # - # @return (`logical`) - ping = function() { - logger::log_trace("TealDataConnection$ping pinging the connection...") - if (!is.null(private$ping_fun)) { - ping_res <- isTRUE(private$ping_fun$run()) - logger::log_trace("TealDataConnection$ping ping result: { ping_res }.") - return(ping_res) - } else { - return(invisible(NULL)) - } - } - ) -) - -#' The constructor for `TealDataConnection` class. -#' -#' @description `r lifecycle::badge("stable")` -#' -#' @param open_fun (`CallableFunction`) function to open connection -#' @param close_fun (`CallableFunction`) function to close connection -#' @param ping_fun (`CallableFunction`) function to ping connection -#' @param if_conn_obj optional, (`logical`) whether to store `conn` object returned from opening -#' -#' @examples -#' open_fun <- callable_function(data.frame) # define opening function -#' open_fun$set_args(list(x = 1:5)) # define fixed arguments to opening function -#' -#' close_fun <- callable_function(sum) # define closing function -#' close_fun$set_args(list(x = 1:5)) # define fixed arguments to closing function -#' -#' ping_fun <- callable_function(function() TRUE) -#' -#' x <- data_connection( # define connection -#' ping_fun = ping_fun, # define ping function -#' open_fun = open_fun, # define opening function -#' close_fun = close_fun # define closing function -#' ) -#' -#' x$set_open_args(args = list(y = letters[1:5])) # define additional arguments if necessary -#' -#' x$open() # call opening function -#' x$get_open_call() # check reproducible R code -#' -#' # get data from connection via TealDataConnector$get_dataset() -#' \dontrun{ -#' x$open(args = list(x = 1:5, y = letters[1:5])) # able to call opening function with arguments -#' x$close() # call closing function -#' } -#' -#' @return `TealDataConnection` object -#' @export -data_connection <- function(open_fun = NULL, close_fun = NULL, ping_fun = NULL, if_conn_obj = FALSE) { - TealDataConnection$new( - open_fun = open_fun, close_fun = close_fun, ping_fun = ping_fun, if_conn_obj = if_conn_obj - ) -} diff --git a/R/TealDataConnector.R b/R/TealDataConnector.R deleted file mode 100644 index f67550eac..000000000 --- a/R/TealDataConnector.R +++ /dev/null @@ -1,570 +0,0 @@ -# TealDataConnector ------ -#' -#' -#' @title Manage multiple and `TealDatasetConnector` of the same type. -#' -#' @description `r lifecycle::badge("stable")` -#' Class manages `TealDatasetConnector` to specify additional dynamic arguments and to -#' open/close connection. -#' -#' @param connection (`TealDataConnection`)\cr -#' connection to data source -#' @param connectors (`list` of `TealDatasetConnector` elements)\cr -#' list with dataset connectors -#' -#' @examples -#' -#' library(scda) -#' adsl <- scda_cdisc_dataset_connector(dataname = "ADSL", "adsl") -#' adlb <- scda_cdisc_dataset_connector(dataname = "ADLB", "adlb") -#' -#' open_fun <- callable_function(library) -#' open_fun$set_args(list(package = "scda")) -#' -#' con <- data_connection(open_fun = open_fun) -#' con$set_open_server( -#' function(id, connection) { -#' moduleServer( -#' id = id, -#' module = function(input, output, session) { -#' connection$open(try = TRUE) -#' return(invisible(connection)) -#' } -#' ) -#' } -#' ) -#' -#' x <- teal.data:::TealDataConnector$new(connection = con, connectors = list(adsl, adlb)) -#' -#' x$set_ui( -#' function(id, connection, connectors) { -#' ns <- NS(id) -#' tagList( -#' connection$get_open_ui(ns("open_connection")), -#' textInput(ns("name"), p("Choose", code("scda data version")), value = "latest"), -#' do.call( -#' what = "tagList", -#' args = lapply( -#' connectors, -#' function(connector) { -#' div( -#' connector$get_ui( -#' id = ns(connector$get_dataname()) -#' ), -#' br() -#' ) -#' } -#' ) -#' ) -#' ) -#' } -#' ) -#' -#' x$set_server( -#' function(id, connection, connectors) { -#' moduleServer( -#' id = id, -#' module = function(input, output, session) { -#' # opens connection -#' connection$get_open_server()(id = "open_connection", connection = connection) -#' if (connection$is_opened()) { -#' for (connector in connectors) { -#' set_args(connector, args = list(archive_name = input$name)) -#' # pull each dataset -#' connector$get_server()(id = connector$get_dataname()) -#' if (connector$is_failed()) { -#' break -#' } -#' } -#' } -#' } -#' ) -#' } -#' ) -#' \dontrun{ -#' x$launch() -#' x$get_datasets() -#' } -TealDataConnector <- R6::R6Class( # nolint - classname = "TealDataConnector", - inherit = TealDataAbstract, - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new `TealDataConnector` object - initialize = function(connection, connectors) { - checkmate::assert_list(connectors, types = "TealDatasetConnector", min.len = 1) - - connectors_names <- vapply(connectors, get_dataname, character(1)) - connectors <- setNames(connectors, connectors_names) - - private$check_names(connectors_names) - - if (!missing(connection)) { - stopifnot(inherits(connection, "TealDataConnection")) - private$connection <- connection - } - - private$datasets <- connectors - - private$pull_code <- CodeClass$new() - private$mutate_code <- CodeClass$new() - - self$id <- sample.int(1e11, 1, useHash = TRUE) - - - logger::log_trace( - "TealDataConnector initialized with data: { paste(self$get_datanames(), collapse = ' ') }." - ) - return(invisible(self)) - }, - #' @description - #' Prints this `TealDataConnector`. - #' - #' @param ... additional arguments to the printing method - #' @return invisibly self - print = function(...) { - check_ellipsis(...) - - cat(sprintf( - "A currently %s %s object containing %d TealDataset/TealDatasetConnector object(s) as element(s).\n", - ifelse(self$get_connection()$is_opened(), "opened", "not yet opened"), - class(self)[1], - length(private$datasets) - )) - cat(sprintf( - "%d of which is/are loaded/pulled:\n", - sum(vapply(private$datasets, function(x) x$is_pulled(), FUN.VALUE = logical(1))) - )) - - for (i in seq_along(private$datasets)) { - cat(sprintf("--> Element %d:\n", i)) - print(private$datasets[[i]]) - } - - invisible(self) - }, - - # ___ getters ==== - #' @description - #' Get connection to data source - #' - #' @return connector's connection - get_connection = function() { - return(private$connection) - }, - #' @description - #' Get internal `CodeClass` object - #' - #' @return `CodeClass` - get_code_class = function() { - all_code <- CodeClass$new() - - open_connection_code <- if (!is.null(private$connection)) { - private$connection$get_open_call(deparse = TRUE) - } else { - NULL - } - - if (!is.null(open_connection_code)) { - all_code$set_code(open_connection_code, dataname = "*open") - } - datasets_code_class <- private$get_datasets_code_class() - all_code$append(datasets_code_class) - - close_connection_code <- if (!is.null(private$connection)) { - private$connection$get_close_call(deparse = TRUE, silent = TRUE) - } else { - NULL - } - - if (!is.null(close_connection_code)) { - all_code$set_code(close_connection_code, dataname = "*close") - } - - mutate_code_class <- private$get_mutate_code_class() - all_code$append(mutate_code_class) - - return(all_code) - }, - #' @description get the server function - #' - #' @return the `server` function - get_server = function() { - if (is.null(private$server)) { - stop("No server function set yet. Please use set_server method first.") - } - function(id, connection = private$connection, connectors = private$datasets) { - rv <- reactiveVal(NULL) - moduleServer( - id = id, - module = function(input, output, session) { - private$server(id = "data_input", connection = connection, connectors = connectors) - } - ) - - if (self$is_pulled()) { - return(rv(TRUE)) - } else { - return(rv(FALSE)) - } - } - }, - #' @description get the `preopen` server function - #' - #' @return the `server` function - get_preopen_server = function() { - function(id, connection = private$connection) { - if (!is.null(private$preopen_server)) { - moduleServer( - id = id, - module = function(input, output, session) { - private$preopen_server(id = "data_input", connection = connection) - } - ) - } - } - }, - #' @description - #' Get Shiny module with inputs for all `TealDatasetConnector` objects - #' - #' @param id `character` shiny element id - #' - #' @return the `ui` function - get_ui = function(id) { - if (is.null(private$ui)) { - stop("No UI set yet. Please use set_ui method first.") - } - x <- function(id, connection = private$connection, connectors = private$datasets) { - ns <- NS(id) - tags$div( - h3("Data Connector for:", lapply(self$get_datanames(), code)), - tags$div( - id = ns("data_input"), - private$ui(id = ns("data_input"), connection = connection, connectors = connectors) - ) - ) - } - x(id) - }, - - # ___ setters ==== - #' @description - #' Set argument to the `pull_fun` - #' - #' @param args (named `list`)\cr - #' arguments values as separate list elements named by argument name. These arguments - #' are passed to each dataset. - #' - #' @return nothing - set_pull_args = function(args) { - lapply(private$datasets, function(x) set_args(x, args)) - logger::log_trace("TealDataConnector$set_pull_args pull args set.") - return(invisible(NULL)) - }, - #' @description - #' Set connector UI function - #' - #' @param f (`function`)\cr - #' shiny module as function. Inputs specified in this `ui` are passed to server module - #' defined by `set_server` method. - #' - #' @return nothing - set_ui = function(f) { - stopifnot(inherits(f, "function")) - stopifnot("id" %in% names(formals(f))) - stopifnot(all(c("connection", "connectors") %in% names(formals(f))) || "..." %in% names(formals(f))) - private$ui <- f - logger::log_trace("TealDataConnector$set_ui ui set.") - return(invisible(NULL)) - }, - #' @description - #' Set connector server function - #' - #' This function will be called after submit button will be hit. There is no possibility to - #' specify some dynamic `ui` as `server` function is executed after hitting submit - #' button. - #' - #' @param f (`function`)\cr - #' A shiny module server function that should load data from all connectors - #' - #' @return nothing - set_server = function(f) { - stopifnot(inherits(f, "function")) - stopifnot(all(c("id", "connection", "connectors") %in% names(formals(f)))) - private$server <- f - logger::log_trace("TealDataConnector$set_server server set.") - return(invisible(NULL)) - }, - #' @description - #' Set connector pre-open server function - #' - #' This function will be called before submit button will be hit. - #' - #' @param f (`function`)\cr - #' A shiny module server function - #' - #' @return nothing - set_preopen_server = function(f) { - stopifnot(inherits(f, "function")) - stopifnot(all(c("id", "connection") %in% names(formals(f)))) - private$preopen_server <- f - logger::log_trace("TealDataConnector$set_preopen_server preopen_server set.") - return(invisible(NULL)) - }, - - # ___ pull ==== - #' @description - #' Load data from each `TealDatasetConnector` - #' - #' @param con_args (`NULL` or named `list`)\cr - #' additional dynamic arguments for connection function. `args` will be passed to each - #' `TealDatasetConnector` object to evaluate `CallableFunction` assigned to - #' this dataset. If `args` is null than default set of arguments will be used, otherwise - #' call will be executed on these arguments only (arguments set before will be ignored). - #' `pull` function doesn't update reproducible call, it's just evaluate function. - #' - #' @param args (`NULL` or named `list`)\cr - #' additional dynamic arguments to pull dataset. `args` will be passed to each - #' `TealDatasetConnector` object to evaluate `CallableFunction` assigned to - #' this dataset. If `args` is null than default set of arguments will be used, otherwise - #' call will be executed on these arguments only (arguments set before will be ignored). - #' `pull` function doesn't update reproducible call, it's just evaluate function. - #' - #' @param try (`logical` value)\cr - #' whether perform function evaluation inside `try` clause - #' - #' @return (`self`) invisibly for chaining. In order to get the data please use `get_datasets` method. - pull = function(con_args = NULL, args = NULL, try = TRUE) { - logger::log_trace("TealDataConnector$pull pulling data...") - # open connection - if (!is.null(private$connection)) { - private$connection$open(args = con_args, try = try) - - conn <- private$connection$get_conn() - for (connector in private$datasets) { - connector$get_pull_callable()$assign_to_env("conn", conn) - } - } - - # load datasets - for (dataset in private$datasets) { - load_dataset(dataset, args = args) - } - - # close connection - if (!is.null(private$connection)) private$connection$close(silent = TRUE) - - logger::log_trace("TealDataConnector$pull data pulled.") - - return(invisible(self)) - }, - #' @description - #' Run simple application that uses its `ui` and `server` fields to pull data from - #' connection. - #' - #' Useful for debugging - #' - #' @return An object that represents the app - launch = function() { - # load TealDatasetConnector objects - if (self$is_pulled()) { - stop("All the datasets have already been pulled.") - } - - shinyApp( - ui = fluidPage( - include_js_files(), - theme = get_teal_bs_theme(), - fluidRow( - column( - width = 8, - offset = 2, - tags$div( - id = "data_inputs", - self$get_ui(id = "data_connector"), - actionButton("submit", "Submit"), - `data-proxy-click` = "submit" # handled by jscode in custom.js - hit enter to submit - ), - shinyjs::hidden( - tags$div( - id = "data_loaded", - div( - h3("Data successfully loaded."), - p("You can close this window and get back to R console.") - ) - ) - ) - ) - ) - ), - server = function(input, output, session) { - session$onSessionEnded(stopApp) - self$get_preopen_server()( - id = "data_connector", - connection = private$connection - ) - observeEvent(input$submit, { - rv <- reactiveVal(NULL) - rv( - self$get_server()( - id = "data_connector", - connection = private$connection, - connectors = private$datasets - ) - ) - - observeEvent(rv(), { - if (self$is_pulled()) { - removeUI(sprintf("#%s", session$ns("data_inputs"))) - shinyjs::show("data_loaded") - stopApp() - } - }) - }) - } - ) - }, - - # ___ mutate ==== - #' @description - #' Mutate data by code. - #' - #' @param ... parameters inherited from `TealDataAbstract`. - #' - #' @return Informational message to not use mutate_data() with `TealDataConnectors`. - mutate = function(...) { - stop("TealDataConnectors do not support mutate_data(). - Please use mutate_data() with teal_data() or cdisc_data()") - }, - - # ___ status ==== - #' @description - #' Check if pull or connection has not failed. - #' - #' @return `TRUE` if pull or connection failed, else `FALSE` - is_failed = function() { - private$connection$is_failed() || - any(vapply(private$datasets, function(x) x$is_failed(), logical(1))) - } - ), - ## __Private Fields ==== - private = list( - server = NULL, # shiny server function - preopen_server = NULL, # shiny server function - ui = NULL, # shiny ui function - connection = NULL, # TealDataConnection - - ## __Private Methods ==== - # adds open/close connection code at beginning/end of the dataset code - append_connection_code = function() { - lapply( - private$datasets, - function(connector) { - dataset <- get_dataset(connector) - try( - dataset$set_code(code = paste( - c( - if (!is.null(private$connection)) private$connection$get_open_call(deparse = TRUE), - get_code(dataset, deparse = TRUE, FUN.VALUE = character(1)), - if (!is.null(private$connection)) private$connection$get_close_call(deparse = TRUE, silent = TRUE) - ), - collapse = "\n" - )) - ) - } - ) - } - ) -) - -#' The constructor for `TealDataConnector` class. -#' -#' @description `r lifecycle::badge("stable")` -#' @param connection (`TealDataConnection`)\cr -#' connection to data source -#' @param connectors (`list` of `TealDatasetConnector` elements)\cr -#' list with dataset connectors -#' -#' @examples -#' -#' library(scda) -#' adsl <- scda_cdisc_dataset_connector(dataname = "ADSL", "adsl") -#' adlb <- scda_cdisc_dataset_connector(dataname = "ADLB", "adlb") -#' -#' open_fun <- callable_function(library) -#' open_fun$set_args(list(package = "scda")) -#' -#' con <- data_connection(open_fun = open_fun) -#' con$set_open_server( -#' function(id, connection) { -#' moduleServer( -#' id = id, -#' module = function(input, output, session) { -#' connection$open(try = TRUE) -#' return(invisible(connection)) -#' } -#' ) -#' } -#' ) -#' -#' x <- relational_data_connector(connection = con, connectors = list(adsl, adlb)) -#' -#' x$set_ui( -#' function(id, connection, connectors) { -#' ns <- NS(id) -#' tagList( -#' connection$get_open_ui(ns("open_connection")), -#' textInput(ns("name"), p("Choose", code("scda data version")), value = "latest"), -#' do.call( -#' what = "tagList", -#' args = lapply( -#' connectors, -#' function(connector) { -#' div( -#' connector$get_ui( -#' id = ns(connector$get_dataname()) -#' ), -#' br() -#' ) -#' } -#' ) -#' ) -#' ) -#' } -#' ) -#' -#' x$set_server( -#' function(id, connection, connectors) { -#' moduleServer( -#' id = id, -#' module = function(input, output, session) { -#' # opens connection -#' connection$get_open_server()(id = "open_connection", connection = connection) -#' if (connection$is_opened()) { -#' for (connector in connectors) { -#' set_args(connector, args = list(archive_name = input$name)) -#' # pull each dataset -#' connector$get_server()(id = connector$get_dataname()) -#' if (connector$is_failed()) { -#' break -#' } -#' } -#' } -#' } -#' ) -#' } -#' ) -#' \dontrun{ -#' x$launch() -#' x$get_datasets() -#' } -#' -#' @return `TealDataConnector` object -#' @export -relational_data_connector <- function(connection, connectors) { - stopifnot(inherits(connection, "TealDataConnection")) - checkmate::assert_list(connectors, types = "TealDatasetConnector", min.len = 1) - TealDataConnector$new(connection, connectors) -} diff --git a/R/TealDataset.R b/R/TealDataset.R deleted file mode 100644 index d39be8b19..000000000 --- a/R/TealDataset.R +++ /dev/null @@ -1,937 +0,0 @@ -## TealDataset ==== -#' -#' -#' @title R6 Class representing a dataset with its attributes -#' -#' @description `r lifecycle::badge("stable")` -#' Any `data.frame` object can be stored inside this object. -#' Some attributes like colnames, dimension or column names for a specific type will -#' be automatically derived. -#' -#' @param dataname (`character`)\cr -#' A given name for the dataset it may not contain spaces -#' @param x (`data.frame`)\cr -#' @param keys optional, (`character`)\cr -#' Vector with primary keys -#' @param code (`character`)\cr -#' A character string defining the code needed to produce the data set in `x`. -#' `initialize()` and `recreate()` accept code as `CodeClass` -#' which is also needed to preserve the code uniqueness and correct order. -#' @param label (`character`)\cr -#' Label to describe the dataset -#' @param vars (named `list`)) \cr -#' In case when this object code depends on other `TealDataset` object(s) or -#' other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It is recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' @param metadata (named `list` or `NULL`) \cr -#' Field containing metadata about the dataset. Each element of the list -#' should be atomic and of length one. -#' -#' @seealso [`MAETealDataset`] -#' -TealDataset <- R6::R6Class( # nolint - "TealDataset", - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new object of `TealDataset` class - initialize = function(dataname, - x, - keys = character(0), - code = character(0), - label = character(0), - vars = list(), - metadata = NULL) { - checkmate::assert_string(dataname) - checkmate::assert_data_frame(x) - checkmate::assert_character(keys, any.missing = FALSE) - checkmate::assert( - checkmate::check_character(code, max.len = 1, any.missing = FALSE), - checkmate::check_class(code, "CodeClass") - ) - # label might be NULL also because of taking label attribute from data.frame - missing attr is NULL - checkmate::assert_character(label, max.len = 1, null.ok = TRUE, any.missing = FALSE) - checkmate::assert_list(vars, names = "named") - - validate_metadata(metadata) - - private$.raw_data <- x - private$metadata <- metadata - - private$set_dataname(dataname) - self$set_vars(vars) - self$set_dataset_label(label) - self$set_keys(keys) - - # needed if recreating dataset - we need to preserve code order and uniqueness - private$code <- CodeClass$new() - if (is.character(code)) { - self$set_code(code) - } else { - private$code$append(code) - } - - logger::log_trace("TealDataset initialized for dataset: { deparse1(self$get_dataname()) }.") - return(invisible(self)) - }, - - #' @description - #' Recreate this `TealDataset` with its current attributes. - #' - #' @return a new object of the `TealDataset` class - recreate = function(dataname = self$get_dataname(), - x = self$get_raw_data(), - keys = self$get_keys(), - code = private$code, - label = self$get_dataset_label(), - vars = list(), - metadata = self$get_metadata()) { - res <- self$initialize( - dataname = dataname, - x = x, - keys = keys, - code = code, - label = label, - vars = vars, - metadata = metadata - ) - logger::log_trace("TealDataset$recreate recreated dataset: { deparse1(self$get_dataname()) }.") - return(res) - }, - #' @description - #' Prints this `TealDataset`. - #' - #' @param ... additional arguments to the printing method - #' @return invisibly self - print = function(...) { - check_ellipsis(...) - cat(sprintf( - "A %s object containing the following data.frame (%s rows and %s columns):\n", - class(self)[1], - self$get_nrow(), - self$get_ncol() - )) - print(head(as.data.frame(self$get_raw_data()))) - if (self$get_nrow() > 6) { - cat("...\n") - } - invisible(self) - }, - # ___ getters ==== - #' @description - #' Performs any delayed mutate calls before returning self. - #' - #' @return dataset (`TealDataset`) - get_dataset = function() { - if (self$is_mutate_delayed() && !private$is_any_dependency_delayed()) { - private$mutate_eager() - } - return(self) - }, - #' @description - #' Get all dataset attributes - #' @return (named `list`) with dataset attributes - get_attrs = function() { - x <- append( - attributes(self$get_raw_data()), - list( - column_labels = self$get_column_labels(), - row_labels = self$get_row_labels(), - dataname = self$get_dataname(), - dataset_label = self$get_dataset_label(), - keys = self$get_keys() - ) - ) - return(x) - }, - #' @description - #' Derive the raw data frame inside this object - #' @return `data.frame` - get_raw_data = function() { - private$.raw_data - }, - #' @description - #' Derive the names of all `numeric` columns - #' @return `character` vector. - get_numeric_colnames = function() { - private$get_class_colnames("numeric") - }, - #' @description - #' Derive the names of all `character` columns - #' @return `character` vector. - get_character_colnames = function() { - private$get_class_colnames("character") - }, - #' @description - #' Derive the names of all `factor` columns - #' @return `character` vector. - get_factor_colnames = function() { - private$get_class_colnames("factor") - }, - #' @description - #' Derive the column names - #' @return `character` vector. - get_colnames = function() { - colnames(private$.raw_data) - }, - #' @description - #' Derive the column labels - #' @return `character` vector. - get_column_labels = function() { - formatters::var_labels(private$.raw_data, fill = FALSE) - }, - #' @description - #' Get the number of columns of the data - #' @return `numeric` vector - get_ncol = function() { - ncol(private$.raw_data) - }, - #' @description - #' Get the number of rows of the data - #' @return `numeric` vector - get_nrow = function() { - nrow(private$.raw_data) - }, - #' @description - #' Derive the row names - #' @return `character` vector. - get_rownames = function() { - rownames(private$.raw_data) - }, - #' @description - #' Derive the row labels - #' @return `character` vector. - get_row_labels = function() { - c() - }, - #' @description - #' Derive the `name` which was formerly called `dataname` - #' @return `character` name of the dataset - get_dataname = function() { - private$dataname - }, - #' @description - #' Derive the dataname - #' @return `character` name of the dataset - get_datanames = function() { - private$dataname - }, - #' @description - #' Derive the `label` which was former called `datalabel` - #' @return `character` label of the dataset - get_dataset_label = function() { - private$dataset_label - }, - #' @description - #' Get primary keys of dataset - #' @return (`character` vector) with dataset primary keys - get_keys = function() { - private$.keys - }, - #' @description - #' Get metadata of dataset - #' @return (named `list`) - get_metadata = function() { - private$metadata - }, - #' @description - #' Get the list of dependencies that are `TealDataset` or `TealDatasetConnector` objects - #' - #' @return `list` - get_var_r6 = function() { - return(private$var_r6) - }, - # ___ setters ==== - #' @description - #' Overwrites `TealDataset` or `TealDatasetConnector` dependencies of this `TealDataset` with - #' those found in `datasets`. Reassignment - #' refers only to the provided `datasets`, other `vars` remains the same. - #' @details - #' Reassign `vars` in this object to keep references up to date after deep clone. - #' Update is done based on the objects passed in `datasets` argument. - #' Overwrites dependencies with names matching the names of the objects passed - #' in `datasets`. - #' @param datasets (`named list` of `TealDataset(s)` or `TealDatasetConnector(s)`)\cr - #' objects with valid pointers. - #' @return NULL invisible - #' @examples - #' test_dataset <- teal.data:::TealDataset$new( - #' dataname = "iris", - #' x = iris, - #' vars = list(dep = teal.data:::TealDataset$new("iris2", iris)) - #' ) - #' test_dataset$reassign_datasets_vars( - #' list(iris2 = teal.data:::TealDataset$new("iris2", head(iris))) - #' ) - #' - reassign_datasets_vars = function(datasets) { - checkmate::assert_list(datasets, min.len = 0, names = "unique") - - common_var_r6 <- intersect(names(datasets), names(private$var_r6)) - private$var_r6[common_var_r6] <- datasets[common_var_r6] - - common_vars <- intersect(names(datasets), names(private$vars)) - private$vars[common_vars] <- datasets[common_vars] - - common_mutate_vars <- intersect(names(datasets), names(private$mutate_vars)) - private$mutate_vars[common_mutate_vars] <- datasets[common_mutate_vars] - - logger::log_trace( - "TealDataset$reassign_datasets_vars reassigned vars for dataset: { deparse1(self$get_dataname()) }." - ) - invisible(NULL) - }, - #' @description - #' Set the label for the dataset - #' @return (`self`) invisibly for chaining - set_dataset_label = function(label) { - if (is.null(label)) { - label <- character(0) - } - checkmate::assert_character(label, max.len = 1, any.missing = FALSE) - private$dataset_label <- label - - logger::log_trace( - "TealDataset$set_dataset_label dataset_label set for dataset: { deparse1(self$get_dataname()) }." - ) - return(invisible(self)) - }, - #' @description - #' Set new keys - #' @return (`self`) invisibly for chaining. - set_keys = function(keys) { - checkmate::assert_character(keys, any.missing = FALSE) - private$.keys <- keys - logger::log_trace(sprintf( - "TealDataset$set_keys set the keys %s for dataset: %s", - paste(keys, collapse = ", "), - self$get_dataname() - )) - return(invisible(self)) - }, - - #' @description - #' Adds variables which code depends on - #' - #' @param vars (`named list`) contains any R object which code depends on - #' @return (`self`) invisibly for chaining - set_vars = function(vars) { - private$set_vars_internal(vars, is_mutate_vars = FALSE) - logger::log_trace("TealDataset$set_vars vars set for dataset: { deparse1(self$get_dataname()) }.") - - return(invisible(NULL)) - }, - #' @description - #' Sets reproducible code - #' - #' @return (`self`) invisibly for chaining - set_code = function(code) { - checkmate::assert_character(code, max.len = 1, any.missing = FALSE) - - if (length(code) > 0 && code != "") { - private$code$set_code( - code = code, - dataname = self$get_datanames(), - deps = names(private$vars) - ) - } - logger::log_trace("TealDataset$set_code code set for dataset: { deparse1(self$get_dataname()) }.") - return(invisible(NULL)) - }, - - # ___ get_code ==== - #' @description - #' Get code to get data - #' - #' @param deparse (`logical`) whether return deparsed form of a call - #' - #' @return optionally deparsed `call` object - get_code = function(deparse = TRUE) { - checkmate::assert_flag(deparse) - res <- self$get_code_class()$get_code(deparse = deparse) - return(res) - }, - #' @description - #' Get internal `CodeClass` object - #' @param nodeps (`logical(1)`) whether `CodeClass` should not contain the code - #' of the dependent `vars` - #' the `mutate` - #' @return `CodeClass` - get_code_class = function(nodeps = FALSE) { - res <- CodeClass$new() - # precise order matters - if (!nodeps) { - res$append(list_to_code_class(private$vars)) - res$append(list_to_code_class(private$mutate_vars)) - } - res$append(private$code) - res$append(private$mutate_list_to_code_class()) - - return(res) - }, - #' @description - #' Get internal `CodeClass` object - #' - #' @return `CodeClass` - get_mutate_code_class = function() { - res <- CodeClass$new() - res$append(list_to_code_class(private$mutate_vars)) - res$append(private$mutate_list_to_code_class()) - - return(res) - }, - #' @description - #' Get internal `vars` object - #' - #' @return `list` - get_vars = function() { - return(c( - private$vars, - private$mutate_vars[!names(private$mutate_vars) %in% names(private$vars)] - )) - }, - #' @description - #' Get internal `mutate_vars` object - #' - #' @return `list` - get_mutate_vars = function() { - return(private$mutate_vars) - }, - - #' @description - #' Whether mutate code has delayed evaluation. - #' @return `logical` - is_mutate_delayed = function() { - return(length(private$mutate_code) > 0) - }, - - # ___ mutate ==== - #' @description - #' Mutate dataset by code - #' - #' @param code (`CodeClass`) or (`character`) R expressions to be executed - #' @param vars a named list of R objects that `code` depends on to execute - #' @param force_delay (`logical`) used by the containing `TealDatasetConnector` object - #' - #' Either code or script must be provided, but not both. - #' - #' @return (`self`) invisibly for chaining - mutate = function(code, vars = list(), force_delay = FALSE) { - logger::log_trace( - sprintf( - "TealDatasetConnector$mutate mutating dataset '%s' using the code (%s lines) and vars (%s).", - self$get_dataname(), - length(parse(text = if (inherits(code, "CodeClass")) code$get_code() else code, keep.source = FALSE)), - paste(names(vars), collapse = ", ") - ) - ) - - checkmate::assert_flag(force_delay) - checkmate::assert_list(vars, min.len = 0, names = "unique") - checkmate::assert( - checkmate::check_string(code), - checkmate::check_class(code, "CodeClass") - ) - - if (inherits(code, "PythonCodeClass")) { - self$set_vars(vars) - self$set_code(code$get_code()) - new_df <- code$eval(dataname = self$get_dataname()) - - # dataset is recreated by replacing data by mutated object - # mutation code is added to the code which replicates the data - self$recreate( - x = new_df, - vars = list() - ) - } else { - private$mutate_delayed(code, vars) - if (!(private$is_any_dependency_delayed(vars) || force_delay)) { - private$mutate_eager() - } - } - logger::log_trace( - sprintf( - "TealDataset$mutate mutated dataset '%s' using the code (%s lines) and vars (%s).", - self$get_dataname(), - length(parse(text = if (inherits(code, "CodeClass")) code$get_code() else code, keep.source = FALSE)), - paste(names(vars), collapse = ", ") - ) - ) - - return(invisible(self)) - }, - - # ___ check ==== - #' @description - #' Check to determine if the raw data is reproducible from the `get_code()` code. - #' @return - #' `TRUE` if the dataset generated from evaluating the - #' `get_code()` code is identical to the raw data, else `FALSE`. - check = function() { - logger::log_trace( - "TealDataset$check executing the code to reproduce dataset: { deparse1(self$get_dataname()) }..." - ) - if (!checkmate::test_character(self$get_code(), len = 1, pattern = "\\w+")) { - stop( - sprintf( - "Cannot check preprocessing code of '%s' - code is empty.", - self$get_dataname() - ) - ) - } - - new_set <- private$execute_code( - code = self$get_code_class(), - vars = c( - list(), # list() in the beginning to ensure c.list - private$vars, - setNames(list(self), self$get_dataname()) - ) - ) - - res_check <- tryCatch( - { - identical(self$get_raw_data(), new_set) - }, - error = function(e) { - FALSE - } - ) - logger::log_trace("TealDataset$check { deparse1(self$get_dataname()) } reproducibility result: { res_check }.") - - return(res_check) - }, - #' @description - #' Check if keys has been specified correctly for dataset. Set of `keys` - #' should distinguish unique rows or be `character(0)`. - #' - #' @return `TRUE` if dataset has been already pulled, else `FALSE` - check_keys = function(keys = private$.keys) { - if (length(keys) > 0) { - if (!all(keys %in% self$get_colnames())) { - stop("Primary keys specifed for ", self$get_dataname(), " do not exist in the data.") - } - - duplicates <- get_key_duplicates(self$get_raw_data(), keys) - if (nrow(duplicates) > 0) { - stop( - "Duplicate primary key values found in the dataset '", self$get_dataname(), "' :\n", - paste0(utils::capture.output(print(duplicates))[-c(1, 3)], collapse = "\n"), - call. = FALSE - ) - } - } - logger::log_trace("TealDataset$check_keys keys checking passed for dataset: { deparse1(self$get_dataname()) }.") - }, - #' @description - #' Check if dataset has already been pulled. - #' - #' @return `TRUE` if dataset has been already pulled, else `FALSE` - is_pulled = function() { - return(TRUE) - } - ), - ## __Private Fields ==== - private = list( - .raw_data = data.frame(), - metadata = NULL, - dataname = character(0), - code = NULL, # CodeClass after initialization - vars = list(), - var_r6 = list(), - dataset_label = character(0), - .keys = character(0), - mutate_code = list(), - mutate_vars = list(), - - ## __Private Methods ==== - mutate_delayed = function(code, vars) { - private$set_vars_internal(vars, is_mutate_vars = TRUE) - private$mutate_code[[length(private$mutate_code) + 1]] <- list(code = code, deps = names(vars)) - logger::log_trace( - sprintf( - "TealDatasetConnector$mutate_delayed set the code (%s lines) and vars (%s) for dataset: %s.", - length(parse(text = if (inherits(code, "CodeClass")) code$get_code() else code, keep.source = FALSE)), - paste(names(vars), collapse = ", "), - self$get_dataname() - ) - ) - return(invisible(self)) - }, - mutate_eager = function() { - logger::log_trace( - "TealDatasetConnector$mutate_eager executing mutate code for dataset: { deparse1(self$get_dataname()) }..." - ) - new_df <- private$execute_code( - code = private$mutate_list_to_code_class(), - vars = c( - list(), # list() in the beginning to ensure c.list - private$vars, - # if they have the same name, then they are guaranteed to be identical objects. - private$mutate_vars[!names(private$mutate_vars) %in% names(private$vars)], - setNames(list(self), self$get_dataname()) - ) - ) - - # code set after successful evaluation - # otherwise code != dataset - # private$code$append(private$mutate_code) # nolint - private$append_mutate_code() - self$set_vars(private$mutate_vars) - private$mutate_code <- list() - private$mutate_vars <- list() - - # dataset is recreated by replacing data by mutated object - # mutation code is added to the code which replicates the data - # because new_code contains also code of the - new_self <- self$recreate( - x = new_df, - vars = list() - ) - - logger::log_trace( - "TealDatasetConnector$mutate_eager executed mutate code for dataset: { deparse1(self$get_dataname()) }." - ) - - new_self - }, - - # need to have a custom deep_clone because one of the key fields are reference-type object - # in particular: code is a R6 object that wouldn't be cloned using default clone(deep = T) - deep_clone = function(name, value) { - deep_clone_r6(name, value) - }, - get_class_colnames = function(class_type = "character") { - checkmate::assert_string(class_type) - return_cols <- self$get_colnames()[which(vapply( - lapply(self$get_raw_data(), class), - function(x, target_class_name) any(x %in% target_class_name), - logical(1), - target_class_name = class_type - ))] - - return(return_cols) - }, - mutate_list_to_code_class = function() { - res <- CodeClass$new() - for (mutate_code in private$mutate_code) { - if (inherits(mutate_code$code, "CodeClass")) { - res$append(mutate_code$code) - } else { - res$set_code( - code = mutate_code$code, - dataname = private$dataname, - deps = mutate_code$deps - ) - } - } - return(res) - }, - append_mutate_code = function() { - for (mutate_code in private$mutate_code) { - if (inherits(mutate_code$code, "CodeClass")) { - private$code$append(mutate_code$code) - } else { - private$code$set_code( - code = mutate_code$code, - dataname = private$dataname, - deps = mutate_code$deps - ) - } - } - }, - is_any_dependency_delayed = function(vars = list()) { - any(vapply( - c(list(), private$var_r6, vars), - FUN.VALUE = logical(1), - FUN = function(var) { - if (inherits(var, "TealDatasetConnector")) { - !var$is_pulled() || var$is_mutate_delayed() - } else if (inherits(var, "TealDataset")) { - var$is_mutate_delayed() - } else { - FALSE - } - } - )) - }, - - # Set variables which code depends on - # @param vars (`named list`) contains any R object which code depends on - # @param is_mutate_vars (`logical(1)`) whether this var is used in mutate code - set_vars_internal = function(vars, is_mutate_vars = FALSE) { - checkmate::assert_flag(is_mutate_vars) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - total_vars <- c(list(), private$vars, private$mutate_vars) - - if (length(vars) > 0) { - # not allowing overriding variable names - over_rides <- names(vars)[vapply( - names(vars), - FUN.VALUE = logical(1), - FUN = function(var_name) { - var_name %in% names(total_vars) && - !identical(total_vars[[var_name]], vars[[var_name]]) - } - )] - if (length(over_rides) > 0) { - stop(paste("Variable name(s) already used:", paste(over_rides, collapse = ", "))) - } - if (is_mutate_vars) { - private$mutate_vars <- c( - private$mutate_vars[!names(private$mutate_vars) %in% names(vars)], - vars - ) - } else { - private$vars <- c( - private$vars[!names(private$vars) %in% names(vars)], - vars - ) - } - } - # only adding dependencies if checks passed - private$set_var_r6(vars) - return(invisible(NULL)) - }, - - # Evaluate script code to modify data or to reproduce data - # - # Evaluate script code to modify data or to reproduce data - # @param vars (named `list`) additional pre-requisite vars to execute code - # @return (`environment`) which stores modified `x` - execute_code = function(code, vars = list()) { - stopifnot(inherits(code, "CodeClass")) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - execution_environment <- new.env(parent = parent.env(globalenv())) - - # set up environment for execution - for (vars_idx in seq_along(vars)) { - var_name <- names(vars)[[vars_idx]] - var_value <- vars[[vars_idx]] - if (inherits(var_value, "TealDatasetConnector") || inherits(var_value, "TealDataset")) { - var_value <- get_raw_data(var_value) - } - assign(envir = execution_environment, x = var_name, value = var_value) - } - - # execute - code$eval(envir = execution_environment) - - if (!is.data.frame(execution_environment[[self$get_dataname()]])) { - out_msg <- sprintf( - "\n%s\n\n - Code from %s need to return a data.frame assigned to an object of dataset name.", - self$get_code(), - self$get_dataname() - ) - - rlang::with_options( - .expr = stop(out_msg, call. = FALSE), - warning.length = max(min(8170, nchar(out_msg) + 30), 100) - ) - } - - new_set <- execution_environment[[self$get_dataname()]] - - return(new_set) - }, - - # Set the name for the dataset - # @param dataname (`character`) the new name - # @return self invisibly for chaining - set_dataname = function(dataname) { - check_simple_name(dataname) - private$dataname <- dataname - return(invisible(self)) - }, - set_var_r6 = function(vars) { - checkmate::assert_list(vars, min.len = 0, names = "unique") - for (varname in names(vars)) { - var <- vars[[varname]] - - if (inherits(var, "TealDatasetConnector") || inherits(var, "TealDataset")) { - var_deps <- var$get_var_r6() - var_deps[[varname]] <- var - for (var_dep_name in names(var_deps)) { - var_dep <- var_deps[[var_dep_name]] - if (identical(self, var_dep)) { - stop("Circular dependencies detected") - } - private$var_r6[[var_dep_name]] <- var_dep - } - } - } - return(invisible(self)) - } - ), - ## __Active Fields ==== - active = list( - #' @field raw_data The data.frame behind this R6 class - raw_data = function() { - private$.raw_data - }, - #' @field data The data.frame behind this R6 class - data = function() { - private$.raw_data - }, - #' @field var_names The column names of the data - var_names = function() { - colnames(private$.raw_data) - } - ) -) - -## Constructors ==== - -#' Constructor for [`TealDataset`] class -#' -#' @description `r lifecycle::badge("stable")` -#' -#' @param dataname (`character`) a given name for the dataset, it cannot contain spaces -#' -#' @param x (`data.frame` or `MultiAssayExperiment`) object from which the dataset will be created -#' -#' @param keys optional, (`character`) vector with primary keys -#' -#' @param code (`character`) a character string defining the code needed to -#' produce the data set in `x` -#' -#' @param label (`character`) label to describe the dataset -#' -#' @param vars (named `list`) in case when this object code depends on other `TealDataset` -#' object(s) or other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' -#' @param metadata (named `list` or `NULL`) field containing metadata about the dataset. -#' Each element of the list should be atomic and length one. -#' -#' @return [`TealDataset`] object -#' -#' @rdname dataset -#' -#' @export -#' -#' @examples -#' # Simple example -#' dataset("iris", iris) -#' -#' # Example with more arguments -#' library(scda) -#' \dontrun{ -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' ADSL_dataset <- dataset(dataname = "ADSL", x = ADSL) -#' -#' ADSL_dataset$get_dataname() -#' -#' ADSL_dataset <- dataset( -#' dataname = "ADSL", -#' x = ADSL, -#' label = "AdAM subject-level dataset", -#' code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl", -#' metadata = list(type = "synthetic data") -#' ) -#' ADSL_dataset$get_metadata() -#' ADSL_dataset$get_dataset_label() -#' ADSL_dataset$get_code() -#' } -dataset <- function(dataname, - x, - keys = character(0), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL) { - UseMethod("dataset", x) -} - -#' @rdname dataset -#' @export -dataset.data.frame <- function(dataname, - x, - keys = character(0), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL) { - checkmate::assert_string(dataname) - checkmate::assert_data_frame(x) - checkmate::assert( - checkmate::check_character(code, max.len = 1, any.missing = FALSE), - checkmate::check_class(code, "CodeClass") - ) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - TealDataset$new( - dataname = dataname, - x = x, - keys = keys, - code = code, - label = label, - vars = vars, - metadata = metadata - ) -} - -#' Load `TealDataset` object from a file -#' -#' @description `r lifecycle::badge("experimental")` -#' Please note that the script has to end with a call creating desired object. The error will be raised otherwise. -#' -#' @param path (`character`) string giving the pathname of the file to read from. -#' @param code (`character`) reproducible code to re-create object -#' -#' @return `TealDataset` object -#' -#' @export -#' -#' @examples -#' # simple example -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(teal.data) -#' dataset(dataname = \"iris\", -#' x = iris, -#' code = \"iris\")" -#' ), -#' con = file_example -#' ) -#' x <- dataset_file(file_example, code = character(0)) -#' get_code(x) -#' -#' # custom code -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(teal.data) -#' -#' # code> -#' x <- iris -#' x$a1 <- 1 -#' x$a2 <- 2 -#' -#' # `. Can't be used simultaneously with `script` -#' -#' @param script (`character`)\cr -#' Alternatively to `code` - location of the file containing modification code. -#' Can't be used simultaneously with `script`. -#' -#' @param vars (named `list`)) \cr -#' In case when this object code depends on other `TealDataset` object(s) or -#' other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' -#' @param metadata (named `list`, `NULL` or `CallableFunction`) \cr -#' Field containing either the metadata about the dataset (each element of the list -#' should be atomic and length one) or a `CallableFuntion` to pull the metadata -#' from a connection. This should return a `list` or an object which can be -#' converted to a list with `as.list`. -TealDatasetConnector <- R6::R6Class( # nolint - - ## __Public Methods ==== - classname = "TealDatasetConnector", - public = list( - #' @description - #' Create a new `TealDatasetConnector` object. Set the pulling function - #' `CallableFunction` which returns a `data.frame` or `MultiAssayExperiment`, - #' e.g. by reading from a function or creating it on the fly. - initialize = function(dataname, - pull_callable, - keys = character(0), - label = character(0), - code = character(0), - vars = list(), - metadata = NULL) { - private$set_pull_callable(pull_callable) - private$set_var_r6(vars) - private$set_pull_vars(vars) - - private$set_dataname(dataname) - private$set_metadata(metadata) - - self$set_dataset_label(label) - self$set_keys(keys) - - if (length(code) > 0) { - # just needs a dummy TealDataset object to store mutate code, hence col = 1 - private$dataset <- TealDataset$new(dataname = self$get_dataname(), x = data.frame(col = 1)) - private$dataset$mutate(code = code, vars = vars, force_delay = TRUE) - } - - logger::log_trace("TealDatasetConnector initialized for dataset: { deparse1(self$get_dataname()) }.") - - return(invisible(self)) - }, - #' @description - #' Prints this `TealDatasetConnector`. - #' - #' @param ... additional arguments to the printing method - #' @return invisibly self - print = function(...) { - check_ellipsis(...) - - cat(sprintf( - "A %s object, named %s, containing a TealDataset object that has %sbeen loaded/pulled%s\n", - class(self)[1], - self$get_dataname(), - ifelse(self$is_pulled(), "", "not "), - ifelse(self$is_pulled(), ":", "") - )) - if (self$is_pulled()) { - print(self$get_dataset()) - } - - invisible(self) - }, - - # ___ getters ==== - #' @description - #' Get dataname of dataset - #' - #' @return dataname of the dataset - get_dataname = function() { - return(private$dataname) - }, - #' @description - #' Get dataname of dataset - #' - #' @return `character` dataname of the dataset - get_datanames = function() { - return(private$dataname) - }, - #' @description - #' Get label of dataset - #' - #' @return `character` dataset label - get_dataset_label = function() { - return(private$dataset_label) - }, - #' @description - #' Get primary keys of dataset - #' @return `character` vector with dataset primary keys - get_keys = function() { - return(private$keys) - }, - #' @description - #' Get code to get data - #' - #' @param deparse (`logical`)\cr - #' whether return deparsed form of a call - #' - #' @return optionally deparsed `call` object - get_code = function(deparse = TRUE) { - checkmate::assert_flag(deparse) - return(self$get_code_class()$get_code(deparse = deparse)) - }, - #' @description - #' Get internal `CodeClass` object - #' - #' @return `CodeClass` - get_code_class = function() { - code_class <- CodeClass$new() - pull_code_class <- private$get_pull_code_class() - code_class$append(pull_code_class) - - if (!is.null(private$dataset)) { - executed_code_in_dataset <- private$dataset$get_code_class() - code_class$append(executed_code_in_dataset) - } - - return(code_class) - }, - #' @description - #' - #' Derive the arguments this connector will pull with - #' @return `list` of pull function fixed arguments - get_pull_args = function() { - private$pull_callable$get_args() - }, - #' @description - #' Get dataset - #' - #' @return dataset (`TealDataset`) - get_dataset = function() { - if (!self$is_pulled()) { - stop( - sprintf("'%s' has not been pulled yet\n - please use `load_dataset()` first.", self$get_dataname()), - call. = FALSE - ) - } - private$dataset$get_dataset() - return(private$dataset) - }, - #' @description - #' Get error message from last pull - #' - #' @return `character` object with error message or `character(0)` if last - #' pull was successful. - get_error_message = function() { - return(private$pull_callable$get_error_message()) - }, - #' @description - #' Get pull function - #' - #' @return `CallableFunction` - get_pull_callable = function() { - return(private$pull_callable) - }, - #' @description - #' Get raw data from dataset - #' - #' @return `data.frame` or `MultiAssayExperiment` data - get_raw_data = function() { - dataset <- self$get_dataset() - return(dataset$get_raw_data()) - }, - #' @description - #' Get the list of dependencies that are `TealDataset` or `TealDatasetConnector` objects - #' - #' @return `list` - get_var_r6 = function() { - return(private$var_r6) - }, - - # ___ setters ==== - #' @description - #' Reassign `vars` in this object to keep references up to date after deep clone. - #' Update is done based on the objects passed in `datasets` argument. Reassignment - #' refers only to the provided `datasets`, other `vars` remains the same. - #' @param datasets (`named list` of `TealDataset(s)` or `TealDatasetConnector(s)`)\cr - #' objects with valid pointers. - #' @return NULL invisible - reassign_datasets_vars = function(datasets) { - logger::log_trace( - "TealDatasetConnector$reassign_datasets_vars reassigning vars in dataset: { self$get_dataname() }." - ) - checkmate::assert_list(datasets, min.len = 0, names = "unique") - - common_var_r6 <- intersect(names(datasets), names(private$var_r6)) - private$var_r6[common_var_r6] <- datasets[common_var_r6] - - common_vars <- intersect(names(datasets), names(private$pull_vars)) - private$pull_vars[common_vars] <- datasets[common_vars] - - if (!is.null(private$dataset)) { - private$dataset$reassign_datasets_vars(datasets) - } - logger::log_trace( - "TealDatasetConnector$reassign_datasets_vars reassigned vars in dataset: { self$get_dataname() }." - ) - - invisible(NULL) - }, - #' @description - #' Set label of the `dataset` object - #' - #' @return (`self`) invisibly for chaining - set_dataset_label = function(label) { - if (is.null(label)) { - label <- character(0) - } - checkmate::assert_character(label, max.len = 1, any.missing = FALSE) - private$dataset_label <- label - if (self$is_pulled()) { - private$dataset$set_dataset_label(label) - } - logger::log_trace( - "TealDatasetConnector$set_dataset_label label set for dataset: { deparse1(self$get_dataname()) }." - ) - - return(invisible(self)) - }, - #' @description - #' Set new keys - #' @return (`self`) invisibly for chaining. - set_keys = function(keys) { - checkmate::assert_character(keys, any.missing = FALSE) - if (isTRUE(self$is_pulled())) { - set_keys(private$dataset, keys) - } - private$keys <- keys - logger::log_trace("TealDatasetConnector$set_keys keys set for dataset: { deparse1(self$get_dataname()) }.") - - return(invisible(self)) - }, - - # ___ pull ==== - #' @description - #' Pull the data (and metadata if it is a `Callable`) - #' - #' Read or create data using `pull_callable` specified in the constructor. - #' - #' @param args (`NULL` or named `list`)\cr - #' additional dynamic arguments for pull function. `args` can be omitted if `pull_callable` - #' from constructor already contains all necessary arguments to pull data. One can try - #' to execute `pull_callable` directly by `x$pull_callable$run()` or to get code using - #' `x$pull_callable$get_code()`. `args` specified in pull are used temporary to get data but - #' not saved in code. - #' @param try (`logical` value)\cr - #' whether perform function evaluation inside `try` clause - #' - #' @return (`self`) if successful. - pull = function(args = NULL, try = FALSE) { - logger::log_trace("TealDatasetConnector$pull pulling dataset: {self$get_dataname() }.") - data <- private$pull_internal(args = args, try = try) - if (!self$is_failed()) { - # The first time object is pulled, private$dataset may be NULL if mutate method was never called - has_dataset <- !is.null(private$dataset) - if (has_dataset) { - code_in_dataset <- private$dataset$get_code_class(nodeps = TRUE) - vars_in_dataset <- private$dataset$get_vars() - } - - pulled_metadata <- private$pull_metadata_internal() - private$dataset <- dataset( - dataname = self$get_dataname(), - x = data, - keys = character(0), # keys need to be set after mutate - label = self$get_dataset_label(), - code = private$get_pull_code_class(), - metadata = pulled_metadata - ) - - if (has_dataset) { - private$dataset$mutate( - code = code_in_dataset, - vars = vars_in_dataset - ) - } - set_keys(private$dataset, self$get_keys()) - private$is_pulled_flag <- TRUE - logger::log_trace("TealDatasetConnector$pull pulled dataset: {self$get_dataname() }.") - } else { - logger::log_error("TealDatasetConnector$pull failed to pull dataset: {self$get_dataname() }.") - } - - return(invisible(self)) - }, - #' @description - #' Set arguments to the pulling function - #' - #' @param args (`NULL` or named `list`) dynamic arguments to function - #' - #' @return (`self`) invisibly for chaining - set_args = function(args) { - set_args(private$pull_callable, args) - logger::log_trace("TealDatasetConnector$set_args pull args set for dataset: {self$get_dataname() }.") - return(invisible(self)) - }, - - # ___ mutate ==== - #' @description - #' Dispatcher for either eager or delayed mutate methods - #' - #' Either code or script must be provided, but not both. - #' - #' @return (`self`) invisibly for chaining. - mutate = function(code, vars = list()) { - checkmate::assert_list(vars, min.len = 0, names = "unique") - - if (is.null(private$dataset)) { - # just needs a dummy TealDataset object to store mutate code, hence col = 1 - private$dataset <- TealDataset$new(dataname = self$get_dataname(), x = data.frame(col = 1)) - } - private$dataset$mutate(code = code, vars = vars, force_delay = !self$is_pulled()) - # should be called at the end so that failure in TealDataset object will prevent it. - private$set_var_r6(vars) - logger::log_trace( - sprintf( - "TealDatasetConnector$mutate mutated dataset '%s' using the code (%s lines) and vars (%s).", - self$get_dataname(), - length(parse(text = if (inherits(code, "CodeClass")) code$get_code() else code)), - paste(names(vars), collapse = ", ") - ) - ) - - - return(invisible(self)) - }, - - # ___ status ==== - #' @description - #' Check if pull has not failed. - #' - #' @return `TRUE` if pull failed, else `FALSE` - is_failed = function() { - return(private$pull_callable$is_failed()) - }, - #' @description - #' Check if dataset has already been pulled. - #' - #' @return `TRUE` if connector has been already pulled, else `FALSE` - is_pulled = function() { - private$is_pulled_flag - }, - #' @description - #' Check if dataset has mutations that are delayed - #' - #' @return `logical` - is_mutate_delayed = function() { - if (is.null(private$dataset)) { - FALSE - } else { - private$dataset$is_mutate_delayed() - } - }, - - # ___ check ==== - #' @description - #' Check to determine if the raw data is reproducible from the - #' `get_code()` code. - #' @return - #' `TRUE` always for all connectors to avoid evaluating the same code multiple times. - check = function() { - return(TRUE) - }, - # ___ shiny ==== - #' @description - #' Sets the shiny UI according to the given inputs. - #' Inputs must provide only scalar (length of 1) variables. - #' @param inputs (`function`) A shiny module UI function with single argument `ns`. - #' This function needs to return a list of shiny inputs with their `inputId` wrapped - #' in function `ns`. The `inputId` must match exactly the argument name to be set. - #' See example. - #' Nested lists are not allowed. - #' @return (`self`) invisibly for chaining. - #' @examples - #' ds <- dataset_connector("xyz", pull_callable = callable_function(data.frame)) - #' ds$set_ui_input( - #' function(ns) { - #' list(sliderInput(ns("colA"), "Select value for colA", min = 0, max = 10, value = 3), - #' sliderInput(ns("colB"), "Select value for colB", min = 0, max = 10, value = 7)) - #' } - #' ) - #' \dontrun{ - #' ds$launch() - #' } - set_ui_input = function(inputs = NULL) { - stopifnot(is.null(inputs) || is.function(inputs)) - if (is.function(inputs)) { - if (!identical(names(formals(inputs)), "ns")) { - stop("'inputs' must be a function of a single argument called 'ns'") - } - } - private$ui_input <- inputs - logger::log_trace( - "TealDatasetConnector$set_ui_input ui_input set for dataset: { deparse1(self$get_dataname()) }." - ) - return(invisible(self)) - }, - #' @description - #' Get shiny ui function - #' @param id (`character`) namespace id - #' @return shiny UI in given namespace id - get_ui = function(id) { - checkmate::assert_string(id) - if (!is.null(private$ui)) { - private$ui(id) - } - }, - #' @description - #' Get shiny server function - #' @return shiny server function - get_server = function() { - return(private$server) - }, - #' @description - #' Launches a shiny app. - #' @return Shiny app - #' @examples - #' ds <- dataset_connector("xyz", pull_callable = callable_function(data.frame)) - #' ds$set_ui_input( - #' function(ns) { - #' list(sliderInput(ns("colA"), "Select value for colA", min = 0, max = 10, value = 3), - #' sliderInput(ns("colB"), "Select value for colB", min = 0, max = 10, value = 7)) - #' } - #' ) - #' \dontrun{ - #' ds$launch() - #' } - launch = function() { - if (is.null(private$server)) { - stop("No arguments set yet. Please use set_ui_input method first.") - } - shinyApp( - ui = fluidPage( - theme = get_teal_bs_theme(), - self$get_ui(id = "main_app"), - shinyjs::useShinyjs(), - br(), - actionButton("pull", "Get data"), - br(), - tableOutput("result") - ), - server = function(input, output, session) { - session$onSessionEnded(stopApp) - observeEvent(input$pull, { - self$get_server()(id = "main_app") - if (self$is_pulled()) { - output$result <- renderTable(head(self$get_raw_data())) - } - }) - } - ) - } - ), - ## __Private Fields ==== - private = list( - dataset = NULL, # TealDataset - pull_callable = NULL, # Callable - pull_vars = list(), # named list - dataname = character(0), - dataset_label = character(0), - metadata = NULL, # Callable or list - keys = NULL, - var_r6 = list(), - ui_input = NULL, # NULL or list - is_pulled_flag = FALSE, - - ## __Private Methods ==== - ui = function(id) { - ns <- NS(id) - # add namespace to input ids - ui <- if (!is.null(private$ui_input)) { - do.call(private$ui_input, list(ns = ns)) - } else { - NULL - } - # check ui inputs - if (!is.null(ui)) { - checkmate::assert_list(ui, types = "shiny.tag") - attr_class <- vapply(lapply(ui, "[[", i = "attribs"), "[[", character(1), i = "class") - if (!all(grepl("shiny-input-container", attr_class))) { - stop("All elements must be shiny inputs") - } - } - # create ui - if (!is.null(ui)) { - tags$div( - tags$div( - id = ns("inputs"), - h4("TealDataset Connector for ", code(self$get_dataname())), - ui - ) - ) - } - }, - server = function(id, data_args = NULL) { - moduleServer( - id = id, - function(input, output, session) { - withProgress(value = 1, message = paste("Pulling", self$get_dataname()), { - # set args to save them - args set will be returned in the call - dataset_args <- if (!is.null(private$ui_input)) { - reactiveValuesToList(input) - } else { - NULL - } - if (length(dataset_args) > 0) { - self$set_args(args = dataset_args) - } - - self$pull(args = data_args, try = TRUE) - - # print error if any - # error doesn't break an app - if (self$is_failed()) { - shinyjs::alert( - sprintf( - "Error pulling %s:\nError message: %s", - self$get_dataname(), - self$get_error_message() - ) - ) - } - }) - } - ) - return(invisible(self)) - }, - - # need to have a custom deep_clone because one of the key fields are reference-type object - # in particular: dataset is a R6 object that wouldn't be cloned using default clone(deep = T) - deep_clone = function(name, value) { - deep_clone_r6(name, value) - }, - get_pull_code_class = function(args = NULL) { - res <- CodeClass$new() - res$append(list_to_code_class(private$pull_vars)) - code <- if (inherits(private$pull_callable, "CallableCode")) { - tmp <- private$pull_callable$get_call(deparse = FALSE) - tmp[[length(tmp)]] <- substitute(a <- b, list(a = as.name(private$dataname), b = tmp[[length(tmp)]])) - paste0(vapply(tmp, deparse1, character(1), collapse = "\n"), collapse = "\n") - } else { - deparse1(substitute( - a <- b, - list( - a = as.name(private$dataname), - b = private$pull_callable$get_call(deparse = FALSE, args = args) - ) - ), collapse = "\n") - } - - res$set_code(code = code, dataname = private$dataname, deps = names(private$pull_vars)) - return(res) - }, - set_pull_callable = function(pull_callable) { - stopifnot(inherits(pull_callable, "Callable")) - private$pull_callable <- pull_callable - return(invisible(self)) - }, - set_metadata = function(metadata) { - if (inherits(metadata, "Callable")) { - private$metadata <- metadata - } else { - validate_metadata(metadata) - private$metadata <- metadata - } - return(invisible(self)) - }, - set_pull_vars = function(pull_vars) { - checkmate::assert_list(pull_vars, min.len = 0, names = "unique") - private$pull_vars <- pull_vars - return(invisible(self)) - }, - pull_metadata_internal = function() { - if (!checkmate::test_class(private$metadata, "Callable")) { - return(private$metadata) - } - - logger::log_trace("TealDatasetConnector$pull pulling metadata for dataset: {self$get_dataname() }.") - pulled_metadata <- private$metadata$run(try = TRUE) - - if (checkmate::test_class(pulled_metadata, c("simpleError", "error"))) { - logger::log_warn("TealDatasetConnector$pull pulling metadata failed for dataset: {self$get_dataname() }.") - return(NULL) - } - - # metadata pulled, now lets make sure it is valid - tryCatch( - { - pulled_metadata <- as.list(pulled_metadata) - validate_metadata(pulled_metadata) - logger::log_trace("TealDatasetConnector$pull pulled metadata for dataset: {self$get_dataname() }.") - return(pulled_metadata) - }, - error = function(e) { - logger::log_warn("TealDatasetConnector$pull invalid metadata for dataset: {self$get_dataname() }.") - return(NULL) - } - ) - }, - pull_internal = function(args = NULL, try = FALSE) { - # include objects CallableFunction environment - if (length(private$pull_vars) > 0) { - for (var_idx in seq_along(private$pull_vars)) { - var_name <- names(private$pull_vars)[[var_idx]] - var_value <- private$pull_vars[[var_idx]] - - # assignment is done in pull_callable only once - # because x is locked within local environment - # this means that re-assignment is not possible and will be silently skipped - # During the app loading, assign is called only once. - private$pull_callable$assign_to_env( - x = var_name, - value = if (inherits(var_value, "TealDatasetConnector") || inherits(var_value, "TealDataset")) { - get_raw_data(var_value) - } else { - var_value - } - ) - } - } - # eval CallableFunction with dynamic args - tryCatch( - expr = private$pull_callable$run(args = args, try = try), - error = function(e) { - if (grepl("object 'conn' not found", e$message)) { - output_message <- "This dataset connector requires connection object (conn) to be provided." - } else { - output_message <- paste("Could not pull dataset, the following error message was returned:", e$message) - } - stop(output_message, call. = FALSE) - } - ) - }, - set_failure = function(res) { - if (inherits(res, "error")) { - private$failed <- TRUE - private$failure_msg <- conditionMessage(res) - } else { - private$failed <- FALSE - private$failure_msg <- NULL - } - return(NULL) - }, - set_var_r6 = function(vars) { - checkmate::assert_list(vars, min.len = 0, names = "unique") - for (varname in names(vars)) { - var <- vars[[varname]] - - if (inherits(var, "TealDatasetConnector") || inherits(var, "TealDataset")) { - var_deps <- var$get_var_r6() - var_deps[[varname]] <- var - for (var_dep_name in names(var_deps)) { - var_dep <- var_deps[[var_dep_name]] - if (identical(self, var_dep)) { - stop("Circular dependencies detected") - } - private$var_r6[[var_dep_name]] <- var_dep - } - } - } - return(invisible(self)) - }, - set_dataname = function(dataname) { - checkmate::assert_string(dataname) - stopifnot(!grepl("\\s", dataname)) - private$dataname <- dataname - return(invisible(self)) - }, - set_ui = function(ui_args = NULL) { - private$ui <- function(id) { - ns <- NS(id) - # add namespace to input ids - ui <- if (!is.null(ui_args)) { - do.call(ui_args, list(ns = ns)) - } else { - NULL - } - # check ui inputs - if (!is.null(ui)) { - checkmate::assert_list(ui, types = "shiny.tag") - attr_class <- vapply(lapply(ui, "[[", i = "attribs"), "[[", character(1), i = "class") - if (!all(grepl("shiny-input-container", attr_class))) { - stop("All elements must be shiny inputs") - } - } - # create ui - if (!is.null(ui)) { - tags$div( - tags$div( - id = ns("inputs"), - h4("TealDataset Connector for ", code(self$get_dataname())), - ui - ) - ) - } - } - return(invisible(self)) - } - ) -) diff --git a/R/TealDatasetConnector_constructors.R b/R/TealDatasetConnector_constructors.R deleted file mode 100644 index 1a8fbdee5..000000000 --- a/R/TealDatasetConnector_constructors.R +++ /dev/null @@ -1,1110 +0,0 @@ -#' Create a new `TealDatasetConnector` object -#' -#' `r lifecycle::badge("stable")` -#' -#' Create `TealDatasetConnector` from [callable_function]. -#' -#' @param dataname (`character`)\cr -#' A given name for the dataset it may not contain spaces -#' -#' @param pull_callable (`CallableFunction`)\cr -#' function with necessary arguments set to fetch data from connection. -#' -#' @param keys optional, (`character`)\cr -#' vector of dataset primary keys column names -#' -#' @param label (`character`)\cr -#' Label to describe the dataset. -#' -#' @param code (`character`)\cr -#' A character string defining code to modify `raw_data` from this dataset. To modify -#' current dataset code should contain at least one assignment to object defined in `dataname` -#' argument. For example if `dataname = ADSL` example code should contain -#' `ADSL <- `. Can't be used simultaneously with `script` -#' -#' @param script (`character`)\cr -#' Alternatively to `code` - location of the file containing modification code. -#' Can't be used simultaneously with `script`. -#' -#' @param vars (named `list`)) \cr -#' In case when this object code depends on other `TealDataset` object(s) or -#' other constant value, this/these object(s) should be included as named -#' element(s) of the list. For example if this object code needs `ADSL` -#' object we should specify `vars = list(ADSL = )`. -#' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' -#' @param metadata (named `list`, `NULL` or `CallableFunction`) \cr -#' Field containing either the metadata about the dataset (each element of the list -#' should be atomic and length one) or a `CallableFuntion` to pull the metadata -#' from a connection. This should return a `list` or an object which can be -#' converted to a list with `as.list`. -#' @return new `TealDatasetConnector` object -#' -#' @examples -#' library(MultiAssayExperiment) -#' # data.frame example -#' pull_fun2 <- callable_function(data.frame) -#' pull_fun2$set_args(args = list(a = c(1, 2, 3))) -#' dataset_connector("test", pull_fun2) -#' -#' # MultiAssayExperiment example -#' pull_fun <- callable_function( -#' function() { -#' library("MultiAssayExperiment") -#' data("miniACC") -#' return(miniACC) -#' } -#' ) -#' dataset_connector( -#' "miniacc", -#' pull_fun, -#' code = 'library("MultiAssayExperiment"); data("miniACC"); return(miniACC)' -#' ) -#' @export -dataset_connector <- function(dataname, - pull_callable, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - vars = list(), - metadata = NULL) { - checkmate::assert_string(dataname) - stopifnot(inherits(pull_callable, "Callable")) - checkmate::assert_character(keys, any.missing = FALSE) - checkmate::assert_character(code, any.missing = FALSE) - checkmate::assert_character(label, any.missing = FALSE) - - if (!checkmate::test_class(metadata, "Callable", null.ok = TRUE)) { - validate_metadata(metadata) - } - - x <- TealDatasetConnector$new( - dataname = dataname, - pull_callable = pull_callable, - keys = keys, - code = code_from_script(code, script), - label = label, - vars = vars, - metadata = metadata - ) - - return(x) -} - -#' Create a new `CDISCTealDatasetConnector` object -#' -#' `r lifecycle::badge("stable")` -#' -#' Create `CDISCTealDatasetConnector` from [callable_function]. -#' -#' @inheritParams dataset_connector -#' @inheritParams cdisc_dataset -#' -#' @return new `CDISCTealDatasetConnector` object -#' -#' @export -cdisc_dataset_connector <- function(dataname, - pull_callable, - keys, - parent = `if`(identical(dataname, "ADSL"), character(0), "ADSL"), - label = character(0), - code = character(0), - script = character(0), - vars = list(), - metadata = NULL) { - checkmate::assert_string(dataname) - stopifnot(inherits(pull_callable, "Callable")) - checkmate::assert_character(keys, any.missing = FALSE) - checkmate::assert_character(parent, max.len = 1, any.missing = FALSE) - checkmate::assert_character(code, max.len = 1, any.missing = FALSE) - checkmate::assert_character(label, max.len = 1, any.missing = FALSE) - - if (!checkmate::test_class(metadata, "Callable", null.ok = TRUE)) { - validate_metadata(metadata) - } - - x <- CDISCTealDatasetConnector$new( - dataname = dataname, - pull_callable = pull_callable, - keys = keys, - parent = parent, - code = code_from_script(code, script), - label = label, - vars = vars, - metadata = metadata - ) - - return(x) -} - - -#' Load `TealDatasetConnector` object from a file -#' -#' `r lifecycle::badge("stable")` -#' -#' Please note that the script has to end with a call creating desired object. The error will -#' be raised otherwise. -#' -#' @inheritParams dataset_file -#' -#' @return `TealDatasetConnector` object -#' -#' @rdname dataset_connector_file -#' -#' @export -#' -#' @examples -#' # simple example -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(teal.data) -#' library(scda) -#' -#' pull_callable <- callable_function(function() {synthetic_cdisc_data('latest')$adsl}) -#' dataset_connector(\"ADSL\", pull_callable, get_cdisc_keys(\"ADSL\"))" -#' ), -#' con = file_example -#' ) -#' x <- dataset_connector_file(file_example) -#' get_code(x) -dataset_connector_file <- function(path) { # nolint - object <- object_file(path, "TealDatasetConnector") - return(object) -} - -#' Load `CDISCTealDatasetConnector` object from a file -#' -#' `r lifecycle::badge("stable")` -#' -#' Please note that the script has to end with a call creating desired object. The error will -#' be raised otherwise. -#' -#' @inheritParams dataset_connector_file -#' -#' @return `CDISCTealDatasetConnector` object -#' -#' @rdname dataset_connector_file -#' -#' @export -#' -#' @examples -#' # simple example -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(teal.data) -#' library(scda) -#' -#' pull_callable <- callable_function(function() {synthetic_cdisc_data('latest')$adsl}) -#' cdisc_dataset_connector(\"ADSL\", pull_callable, get_cdisc_keys(\"ADSL\"))" -#' ), -#' con = file_example -#' ) -#' x <- cdisc_dataset_connector_file(file_example) -#' get_code(x) -cdisc_dataset_connector_file <- function(path) { # nolint - object <- object_file(path, "CDISCTealDatasetConnector") - return(object) -} - - -# SCDA ==== -#' `scda` `TealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `TealDatasetConnector` for dataset in `scda` -#' -#' @inheritParams dataset_connector -#' @inheritParams fun_dataset_connector -#' @param scda_dataname (`character`) which `scda` dataset to use (e.g. `adsl`). -#' @param scda_name (`character`) which version of `scda` data to take, default "latest". -#' @rdname scda_dataset_connector -#' -#' @export -#' -#' @examples -#' library(scda) -#' x <- scda_dataset_connector( -#' dataname = "ADSL", scda_dataname = "adsl", -#' ) -#' x$get_code() -#' load_dataset(x) -#' get_dataset(x) -#' get_dataset(x)$get_metadata() -#' x$get_raw_data() -#' -#' metadata_fun <- callable_function(function(a) list(type = a)) -#' metadata_fun$set_args(args = list(a = "scda")) -#' y <- scda_dataset_connector( -#' dataname = "ADSL", scda_dataname = "adsl", -#' metadata = metadata_fun -#' ) -#' load_dataset(y) -#' get_dataset(y)$get_metadata() -scda_dataset_connector <- function(dataname, - scda_dataname = tolower(dataname), - scda_name = "latest", - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "scda", version = scda_name)) { - check_pkg_quietly("scda", "scda package not available.") - checkmate::assert_string(scda_dataname) - checkmate::assert_string(scda_name) - if (scda_dataname == "latest") { - stop("scda_dataname should be a dataset name e.g 'adsl' not 'latest'") - } - - x <- fun_dataset_connector( - dataname = dataname, - fun = scda::synthetic_cdisc_dataset, - fun_args = list(dataset_name = scda_dataname, archive_name = scda_name), - keys = keys, - label = label, - code = code_from_script(code, script), - metadata = metadata - ) - - return(x) -} - -#' `SCDA` `CDISCTealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `CDISCTealDatasetConnector` from `scda` data -#' -#' @inheritParams scda_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @rdname scda_dataset_connector -#' -#' @export -scda_cdisc_dataset_connector <- function(dataname, - scda_dataname = tolower(dataname), - scda_name = "latest", - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "scda", version = scda_name)) { - x <- scda_dataset_connector( - dataname = dataname, - scda_dataname = scda_dataname, - scda_name = scda_name, - keys = keys, - code = code, - script = script, - label = label, - metadata = metadata - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} - - -# RDS ==== -#' `RDS` `TealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `TealDatasetConnector` from `RDS` file. -#' -#' @inheritParams dataset_connector -#' @inheritParams fun_dataset_connector -#' @param file (`character`)\cr -#' path to (`.rds` or `.R`) that contains `data.frame` object or -#' code to `source` -#' -#' @param ... (`optional`)\cr -#' additional arguments applied to [base::readRDS()] function -#' -#' @export -#' -#' @rdname rds_dataset_connector -#' -#' @examples -#' \dontrun{ -#' x <- rds_dataset_connector( -#' dataname = "ADSL", -#' file = "path/to/file.RDS" -#' ) -#' x$get_code() -#' } -rds_dataset_connector <- function(dataname, - file, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "rds", file = file), - ...) { - dot_args <- list(...) - checkmate::assert_list(dot_args, min.len = 0, names = "unique") - checkmate::assert_string(file) - if (!file.exists(file)) { - stop("File ", file, " does not exist.", call. = FALSE) - } - - x_fun <- callable_function(readRDS) # nolint - args <- c(list(file = file), dot_args) - x_fun$set_args(args) - - x <- dataset_connector( - dataname = dataname, - pull_callable = x_fun, - keys = keys, - label = label, - code = code_from_script(code, script), - metadata = metadata - ) - - return(x) -} - -#' `RDS` `CDSICTealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `CDSICTealDatasetConnector` from `RDS` file with keys automatically -#' assigned by `dataname` -#' -#' @inheritParams rds_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @rdname rds_dataset_connector -#' -#' @export -rds_cdisc_dataset_connector <- function(dataname, - file, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "rds", file = file), - ...) { - x <- rds_dataset_connector( - dataname = dataname, - file = file, - keys = keys, - code = code_from_script(code, script), - label = label, - metadata = metadata, - ... - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} - - -# SCRIPT ==== -#' Script `TealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `TealDatasetConnector` from `.R` file. -#' -#' @inheritParams dataset_connector -#' @inheritParams fun_dataset_connector -#' @param file (`character`)\cr -#' file location containing code to be evaluated in connector. Object obtained in the last -#' call from file will be returned to the connector - same as `source(file = file)$value` -#' -#' @export -#' -#' @rdname script_dataset_connector -#' -#' @examples -#' \dontrun{ -#' x <- script_dataset_connector( -#' dataname = "ADSL", -#' file = "path/to/script.R", -#' keys = get_cdisc_keys("ADSL") -#' ) -#' x$get_code() -#' } -script_dataset_connector <- function(dataname, - file, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = NULL, - ...) { - vars <- list(...) - checkmate::assert_list(vars, min.len = 0, names = "unique") - checkmate::assert_string(file) - if (!file.exists(file)) { - stop("File ", file, " does not exist.", call. = FALSE) - } - - x_fun <- callable_function(source) # nolint - x_fun$set_args(list(file = file, local = TRUE)) - - x <- dataset_connector( - dataname = dataname, - pull_callable = x_fun, - keys = keys, - label = label, - code = code_from_script(code, script), - vars = vars, - metadata = metadata - ) - - return(x) -} - -#' Script `CDISCTealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `CDISCTealDatasetConnector` from `script` file with keys assigned -#' automatically by `dataname`. -#' -#' @inheritParams script_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @rdname script_dataset_connector -#' -#' @export -script_cdisc_dataset_connector <- function(dataname, - file, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - label = character(0), - code = character(0), - script = character(0), - metadata = NULL, - ...) { - x <- script_dataset_connector( - dataname = dataname, - file = file, - keys = keys, - code = code_from_script(code, script), - script = script, - label = label, - metadata = metadata, - ... - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} - - -# CODE ==== -#' Code `TealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `TealDatasetConnector` from a string of code. -#' -#' @inheritParams dataset_connector -#' @inheritParams fun_dataset_connector -#' -#' @param code (`character`)\cr -#' String containing the code to produce the object. -#' The code must end in a call to the object. -#' @param mutate_code (`character`)\cr -#' String containing the code used to mutate the object -#' after it is produced. -#' @param mutate_script (`character`)\cr -#' Alternatively to `mutate_code` - location of the file containing modification code. -#' Can't be used simultaneously with `mutate_script`. -#' -#' @export -#' -#' @rdname code_dataset_connector -#' -#' @examples -#' library(scda) -#' x <- code_dataset_connector( -#' dataname = "ADSL", -#' keys = get_cdisc_keys("ADSL"), -#' code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl; ADSL" -#' ) -#' -#' x$get_code() -#' -#' mutate_dataset(x, code = "ADSL$new_variable <- 1") -#' x$get_code() -#' -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "seed <- 1; ADSL <- radsl(cached = TRUE, seed = seed)\nADSL" -#' ), -#' con = file_example -#' ) -#' -#' y <- code_dataset_connector( -#' dataname = "ADSL", -#' keys = get_cdisc_keys("ADSL"), -#' code = paste0(readLines(file_example), collapse = "\n") -#' ) -code_dataset_connector <- function(dataname, - code, - keys = character(0), - label = character(0), - mutate_code = character(0), - mutate_script = character(0), - metadata = NULL, - ...) { - vars <- list(...) - checkmate::assert_list(vars, min.len = 0, names = "unique") - checkmate::assert_string(code) - checkmate::assert_character(label, max.len = 1, any.missing = FALSE) - - call <- callable_code(code = code) - - x <- dataset_connector( - dataname = dataname, - pull_callable = call, - keys = keys, - label = label, - code = code_from_script(mutate_code, mutate_script), - vars = vars, - metadata = metadata - ) - - return(x) -} - -#' Code `CDISCTealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `CDISCTealDatasetConnector` from a string of code with keys -#' assigned automatically by `dataname`. -#' -#' @inheritParams code_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @rdname code_dataset_connector -#' -#' @export -code_cdisc_dataset_connector <- function(dataname, - code, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - label = character(0), - mutate_code = character(0), - metadata = NULL, - ...) { - x <- code_dataset_connector( - dataname = dataname, - code = code, - keys = keys, - mutate_code = mutate_code, - label = label, - metadata = metadata, - ... - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} - -# CSV ==== -#' `csv` `TealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `TealDatasetConnector` from `csv` (or general delimited file). -#' -#' -#' @inheritParams dataset_connector -#' @inheritParams fun_dataset_connector -#' -#' @param file (`character`)\cr -#' path to (`.csv)` (or general delimited) file that contains `data.frame` object -#' -#' @param ... (`optional`)\cr -#' additional arguments applied to pull function (`readr::read_delim`) by default -#' `delim = ","`. -#' -#' @export -#' -#' @rdname csv_dataset_connector -#' -#' @examples -#' \dontrun{ -#' x <- csv_dataset_connector( -#' dataname = "ADSL", -#' file = "path/to/file.csv", -#' delim = ",", -#' col_types = quote(readr::cols(AGE = "i")) -#' ) -#' x$get_code() -#' } -csv_dataset_connector <- function(dataname, - file, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "csv", file = file), - ...) { - dot_args <- list(...) - checkmate::assert_list(dot_args, min.len = 0, names = "unique") - - check_pkg_quietly( - "readr", - "library readr is required to use csv connectors please install it." - ) - - # add default delim as "," - if (!"delim" %in% names(dot_args)) { - dot_args$delim <- "," - } - - checkmate::assert_string(file) - if (!file.exists(file)) { - stop("File ", file, " does not exist.", call. = FALSE) - } - - x_fun <- callable_function("readr::read_delim") # using read_delim as preserves dates (read.csv does not) - args <- c(list(file = file), dot_args) - x_fun$set_args(args) - - x <- dataset_connector( - dataname = dataname, - pull_callable = x_fun, - keys = keys, - label = label, - code = code_from_script(code, script), - metadata = metadata - ) - - return(x) -} - -#' `csv` `CDISCTealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `CDISCTealDatasetConnector` from `csv` (or general delimited) file -#' with keys and parent name assigned automatically by `dataname`. -#' -#' @inheritParams csv_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @rdname csv_dataset_connector -#' -#' @export -csv_cdisc_dataset_connector <- function(dataname, - file, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "csv", file = file), - ...) { - x <- csv_dataset_connector( - dataname = dataname, - file = file, - keys = keys, - code = code_from_script(code, script), - label = label, - metadata = metadata, - ... - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} - -# FUN ==== -#' Function Dataset Connector -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `TealDatasetConnector` from `function` and its arguments. -#' -#' @inheritParams dataset_connector -#' -#' @param fun (`function`)\cr -#' a custom function to obtain dataset. -#' @param fun_args (`list`)\cr -#' additional arguments for (`func`). -#' @param func_name (`name`)\cr -#' for internal purposes, please keep it default -#' @param ... Additional arguments applied to pull function. -#' In case when this object code depends on the `raw_data` from the other -#' `TealDataset`, `TealDatasetConnector` object(s) or other constant value, -#' this/these object(s) should be included. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' @export -#' -#' @rdname fun_dataset_connector -#' -#' @examples -#' my_data <- function(...) { -#' data.frame( -#' ID = paste0("ABC_", seq_len(10)), -#' var1 = rnorm(n = 10), -#' var2 = rnorm(n = 10), -#' var3 = rnorm(n = 10) -#' ) -#' } -#' y <- fun_dataset_connector( -#' dataname = "XYZ", -#' fun = my_data -#' ) -#' -#' y$get_code() -#' -#' y$pull() -#' -#' get_raw_data(y) -fun_dataset_connector <- function(dataname, - fun, - fun_args = NULL, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - func_name = substitute(fun), - metadata = NULL, - ...) { - vars <- list(...) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - stopifnot(is.function(fun)) - - stopifnot(is.list(fun_args) || is.null(fun_args)) - - cal <- if (!is.symbol(func_name)) as.call(func_name) else NULL - - is_pak <- FALSE - is_locked <- TRUE - if ((!is.null(cal)) && identical(cal[[1]], as.symbol("::"))) { - pak <- cal[[2]] - pak_char <- as.character(pak) # nolint - library(pak_char, character.only = TRUE) - func_name <- cal[[3]] - is_pak <- TRUE - is_locked <- TRUE - } else { - is_locked <- environmentIsLocked(environment(fun)) - } - - func_char <- as.character(func_name) - - ee <- new.env(parent = parent.env(globalenv())) - - ee$library <- function(...) { - mc <- match.call() - mc[[1]] <- quote(base::library) - eval(mc, envir = globalenv()) - this_env <- parent.frame() - if (!identical(this_env, globalenv())) { - parent.env(this_env) <- parent.env(globalenv()) - } - } - - - if (!is_pak && !is_locked) { - eval(bquote(.(func_name) <- get(.(func_char), .(environment(fun)))), envir = ee) - eval(bquote(.(func_name) <- rlang::set_env(.(func_name), .(ee))), envir = ee) - } - - x_fun <- CallableFunction$new(fun, env = ee) - x_fun$set_args(fun_args) - - vars[[func_char]] <- ee[[func_char]] - - x <- dataset_connector( - dataname = dataname, - pull_callable = x_fun, - keys = keys, - code = code_from_script(code, script), - label = label, - vars = vars, - metadata = metadata - ) - - return(x) -} - -#' Function `CDISCTealDatasetConnector` -#' -#' `r lifecycle::badge("stable")` -#' -#' Create a `CDISCTealDatasetConnector` from `function` and its arguments -#' with keys and parent name assigned automatically by `dataname`. -#' -#' @inheritParams fun_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @rdname fun_dataset_connector -#' -#' @export -fun_cdisc_dataset_connector <- function(dataname, - fun, - fun_args = NULL, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - label = character(0), - code = character(0), - script = character(0), - func_name = substitute(fun), - metadata = NULL, - ...) { - x <- fun_dataset_connector( - dataname = dataname, - fun = fun, - fun_args = fun_args, - func_name = func_name, - keys = keys, - label = label, - code = code, - script = script, - metadata = metadata, - ... - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} - - -# PYTHON ==== -#' `Python` `TealDatasetConnector` -#' -#' `r lifecycle::badge("experimental")` -#' Create a `TealDatasetConnector` from `.py` file or through python code supplied directly. -#' -#' @details -#' Note that in addition to the `reticulate` package, support for python requires an -#' existing python installation. By default, `reticulate` will attempt to use the -#' location `Sys.which("python")`, however the path to the python installation can be -#' supplied directly via `reticulate::use_python`. -#' -#' The `teal` API for delayed data requires the python code or script to return a -#' data.frame object. For this, the `pandas` package is required. This can be installed -#' using `reticulate::py_install("pandas")`. -#' -#' Please see the package documentation for more details. -#' -#' @inheritParams dataset_connector -#' @inheritParams code_dataset_connector -#' @param file (`character`)\cr -#' Path to the file location containing the python script used to generate the object. -#' @param code (`character`)\cr -#' string containing the python code to be run using `reticulate`. Carefully consider -#' indentation to follow proper python syntax. -#' @param object (`character`)\cr -#' name of the object from the python script that is assigned to the dataset to be used. -#' -#' @note -#' Raises an error when passed `code` and `file` are passed at the same time. -#' -#' When using `code`, keep in mind that when using `reticulate` with delayed data, python -#' functions do not have access to other objects in the `code` and must be self contained. -#' In the following example, the function `makedata()` doesn't have access to variable `x`: -#' -#' \preformatted{import pandas as pd -#' -#' x = 1 -#' def makedata(): -#' return pd.DataFrame({'x': [x, 2], 'y': [3, 4]}) -#' -#' data = makedata()} -#' -#' When using custom functions, the function environment must be entirely self contained: -#' -#' \preformatted{def makedata(): -#' import pandas as pd -#' x = 1 -#' return pd.DataFrame({'x': [x, 2], 'y': [3, 4]}) -#' -#' data = makedata() -#' } -#' -#' **Additional `reticulate` considerations:** -#' 1. Note that when using pull `vars`, `R` objects referenced in the python -#' code or script have to be prefixed with `r.`. -#' 2. `reticulate` isn't able to convert `POSIXct` objects. Please take extra -#' care when working with `datetime` variables. -#' -#' Please read the official documentation for the `reticulate` package for additional -#' features and current limitations. -#' -#' @export -#' -#' @rdname python_dataset_connector -#' -#' @examples -#' \dontrun{ -#' library(reticulate) -#' -#' # supply python code directly in R -#' -#' x <- python_dataset_connector( -#' "ADSL", -#' code = "import pandas as pd -#' data = pd.DataFrame({'STUDYID': [1, 2], 'USUBJID': [3, 4]})", -#' object = "data" -#' ) -#' -#' x$pull() -#' x$get_raw_data() -#' -#' # supply an external python script -#' -#' python_file <- tempfile(fileext = ".py") -#' writeLines( -#' text = "import pandas as pd -#' data = pd.DataFrame({'STUDYID': [1, 2], 'USUBJID': [3, 4]})", -#' con = python_file -#' ) -#' -#' x <- python_dataset_connector( -#' "ADSL", -#' file = python_file, -#' object = "data", -#' ) -#' -#' x$pull() -#' x$get_raw_data() -#' -#' # supply pull `vars` from R -#' -#' y <- 8 -#' x <- python_dataset_connector( -#' "ADSL", -#' code = "import pandas as pd -#' data = pd.DataFrame({'STUDYID': [r.y], 'USUBJID': [r.y]})", -#' object = "data", -#' vars = list(y = y) -#' ) -#' -#' x$pull() -#' x$get_raw_data() -#' } -python_dataset_connector <- function(dataname, - file, - code, - object = dataname, - keys = character(0), - label = character(0), - mutate_code = character(0), - mutate_script = character(0), - vars = list(), - metadata = NULL) { - if (!requireNamespace("reticulate", quietly = TRUE)) { - stop("Cannot load package 'reticulate' - please install the package.", call. = FALSE) - } - if (utils::packageVersion("reticulate") < 1.22) { - stop("Please upgrade package 'reticulate', teal.data requires version >= 1.22") - } - - checkmate::assert_string(object) - if (!xor(missing(code), missing(file))) stop("Exactly one of 'code' and 'script' is required") - - if (!missing(file)) { - checkmate::assert_string(file) - checkmate::assert_file_exists(file, extension = "py") - x_fun <- CallablePythonCode$new("py_run_file") # nolint - x_fun$set_args(list(file = file, local = TRUE)) - } else { - checkmate::assert_string(code) - x_fun <- CallablePythonCode$new("py_run_string") # nolint - x_fun$set_args(list(code = code, local = TRUE)) - } - - x_fun$set_object(object) - - x <- dataset_connector( - dataname = dataname, - pull_callable = x_fun, - keys = keys, - label = label, - code = code_from_script(mutate_code, mutate_script), - vars = vars, - metadata = metadata - ) - - return(x) -} - -#' `Python` `CDISCTealDatasetConnector` -#' -#' `r lifecycle::badge("experimental")` -#' Create a `CDISCTealDatasetConnector` from `.py` file or through python code supplied directly. -#' -#' @inheritParams python_dataset_connector -#' @inheritParams cdisc_dataset_connector -#' -#' @export -#' -#' @rdname python_dataset_connector -python_cdisc_dataset_connector <- function(dataname, - file, - code, - object = dataname, - keys = get_cdisc_keys(dataname), - parent = `if`(identical(dataname, "ADSL"), character(0L), "ADSL"), - mutate_code = character(0), - mutate_script = character(0), - label = character(0), - vars = list(), - metadata = NULL) { - x <- python_dataset_connector( - dataname = dataname, - file = file, - code = code, - object = object, - keys = keys, - mutate_code = mutate_code, - mutate_script = mutate_script, - label = label, - vars = vars, - metadata = metadata - ) - - res <- as_cdisc( - x, - parent = parent - ) - - return(res) -} diff --git a/R/as_cdisc.R b/R/as_cdisc.R deleted file mode 100644 index f2bb70258..000000000 --- a/R/as_cdisc.R +++ /dev/null @@ -1,122 +0,0 @@ -#' Convert a `TealDataset(Connector)` object to a `CDISCTealDataset(Connector)` object -#' -#' Convert a `TealDataset(Connector)` object to a `CDISCTealDataset(Connector)` object -#' -#' @description `r lifecycle::badge("stable")` -#' -#' @note If passed a `CDISC`-flavored object it returns the unmodified object. -#' -#' @param x an object of `TealDataset` or `TealDatasetConnector` class -#' @inheritParams cdisc_dataset -#' -#' @return (`CDISCTealDataset` or `CDISCTealDatasetConnector`) object -#' -#' @export -as_cdisc <- function(x, parent = `if`(identical(get_dataname(x), "ADSL"), character(0), "ADSL")) { - if (any(class(x) %in% c("CDISCTealDataset", "CDISCTealDatasetConnector"))) { - x - } else { - UseMethod("as_cdisc") - } -} - -#' @rdname as_cdisc -#' @export -#' @examples -#' # TealDataset -------- -#' -#' library(scda) -#' as_cdisc( -#' dataset( -#' "ADSL", -#' synthetic_cdisc_data("latest")$adsl, -#' keys = get_cdisc_keys("ADSL"), -#' code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" -#' ) -#' ) -#' as_cdisc( -#' dataset( -#' "ADAE", -#' synthetic_cdisc_data("latest")$adae, -#' keys = get_cdisc_keys("ADAE"), -#' code = "ADAE <- synthetic_cdisc_data(\"latest\")$adae" -#' ), -#' parent = "ADSL" -#' ) -as_cdisc.TealDataset <- function(x, parent = `if`(identical(get_dataname(x), "ADSL"), character(0), "ADSL")) { - if (length(get_keys(x)) > 0 || !(get_dataname(x) %in% names(default_cdisc_keys))) { - cdisc_dataset( - dataname = get_dataname(x), - x = get_raw_data(x), - keys = get_keys(x), - parent = parent, - label = get_dataset_label(x), - code = x$get_code_class(), - metadata = x$get_metadata() - ) - } else { - cdisc_dataset( - dataname = get_dataname(x), - x = get_raw_data(x), - parent = parent, - label = get_dataset_label(x), - code = x$get_code_class(), - metadata = x$get_metadata() - ) - } -} - -#' @rdname as_cdisc -#' @export -#' @examples -#' # TealDatasetConnector -------- -#' -#' library(scda) -#' pull_fun_adsl <- callable_function( -#' function() { -#' synthetic_cdisc_data("latest")$adsl -#' } -#' ) -#' as_cdisc( -#' dataset_connector( -#' "ADSL", -#' pull_fun_adsl, -#' keys = get_cdisc_keys("ADSL") -#' ) -#' ) -#' -#' pull_fun_adae <- callable_function( -#' function() { -#' synthetic_cdisc_data("latest")$adae -#' } -#' ) -#' as_cdisc( -#' dataset_connector( -#' "ADAE", -#' pull_fun_adae, -#' keys = get_cdisc_keys("ADAE") -#' ), -#' parent = "ADSL" -#' ) -as_cdisc.TealDatasetConnector <- function(x, parent = `if`(identical(get_dataname(x), "ADSL"), character(0), "ADSL")) { - ds <- tryCatch( - expr = get_dataset(x), - error = function(e) NULL - ) - if (!is.null(ds)) { - warning( - "Pulled 'dataset' from 'x' will not be passed to CDISCTealDatasetConnector. - Avoid pulling before conversion." - ) - } - - cdisc_dataset_connector( - dataname = get_dataname(x), - pull_callable = x$get_pull_callable(), - keys = get_keys(x), - parent = parent, - label = get_dataset_label(x), - vars = x$.__enclos_env__$private$pull_vars, - metadata = x$.__enclos_env__$private$metadata - ) -} diff --git a/R/cdisc_data.R b/R/cdisc_data.R index e97e0723c..1e05ed2fe 100644 --- a/R/cdisc_data.R +++ b/R/cdisc_data.R @@ -18,8 +18,7 @@ #' get_keys(test_data, "ADAE") # returns [1] "STUDYID" "USUBJID" "ASTDTM" "AETERM" "AESEQ" #' ``` #' @inheritParams teal_data -#' @param ... (`TealDataConnector`, `TealDataset` or -#' `TealDatasetConnector`) elements to include. +#' @param data (`list` named) #' @param join_keys (`JoinKeys`) or a single (`JoinKeySet`)\cr #' (optional) object with datasets column names used for joining. #' If empty then it would be automatically derived basing on intersection of datasets primary keys @@ -66,100 +65,16 @@ #' ADTTE <- synthetic_cdisc_data('latest')$adtte", #' check = TRUE #' ) -cdisc_data <- function(..., - join_keys = teal.data::join_keys(), +cdisc_data <- function(data, + join_keys = default_cdisc_join_keys(names(data)), code = "", check = FALSE) { - data_objects <- list(...) - checkmate::assert_list( - data_objects, - types = c("TealDataset", "TealDatasetConnector", "TealDataConnector") - ) - if (inherits(join_keys, "JoinKeySet")) { - join_keys <- teal.data::join_keys(join_keys) - } - - update_join_keys_to_primary(data_objects, join_keys) - - retrieve_parents <- function(x) { - tryCatch( - x$get_parent(), - error = function(cond) rep(character(0), length(x$get_datanames())) - ) - } - - new_parents_fun <- function(data_objects) { - lapply(data_objects, function(x) { - if (inherits(x, "TealDataConnector")) { - unlist(new_parents_fun(x$get_items()), recursive = FALSE) - } else { - list(retrieve_parents(x)) - } - }) - } - - new_parents <- unlist(new_parents_fun(data_objects), recursive = FALSE) - - names(new_parents) <- unlist(lapply(data_objects, function(x) { - if (inherits(x, "TealDataConnector")) { - lapply(x$get_items(), function(z) z$get_dataname()) - } else { - x$get_datanames() - } - })) - - if (is_dag(new_parents)) { - stop("Cycle detected in a parent and child dataset graph.") - } - join_keys$set_parents(new_parents) join_keys$update_keys_given_parents() - - x <- TealData$new(..., check = check, join_keys = join_keys) - - if (length(code) > 0 && !identical(code, "")) { - x$set_pull_code(code = code) - } - - x$check_reproducibility() - x$check_metadata() - return(x) -} - -#' Load `TealData` object from a file -#' -#' @description `r lifecycle::badge("deprecated")` -#' -#' @inheritParams teal_data_file -#' -#' @return `TealData` object -#' -#' @export -#' -#' @examples -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(scda) -#' -#' # code> -#' ADSL <- synthetic_cdisc_data('latest')$adsl -#' ADTTE <- synthetic_cdisc_data('latest')$adtte -#' -#' cdisc_data( -#' cdisc_dataset(\"ADSL\", ADSL), cdisc_dataset(\"ADTTE\", ADTTE), -#' code = \"ADSL <- synthetic_cdisc_data('latest')$adsl -#' ADTTE <- synthetic_cdisc_data('latest')$adtte\", -#' check = FALSE -#' ) -#' # )`. -#' It's recommended to include `TealDataset` or `TealDatasetConnector` objects to -#' the `vars` list to preserve reproducibility. Please note that `vars` -#' are included to this object as local `vars` and they cannot be modified -#' within another dataset. -#' @param ... not used, only for support of S3 -#' -#' @return modified `x` object -#' -#' @export -mutate_dataset <- function(x, ...) { - UseMethod("mutate_dataset") -} - -#' @rdname mutate_dataset -#' @examples -#' library(scda) -#' library(magrittr) -#' -#' ADSL <- synthetic_cdisc_data("latest")$adsl -#' -#' ADSL_dataset <- dataset( -#' dataname = "ADSL", -#' x = ADSL, -#' label = "AdAM subject-level dataset", -#' code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" -#' ) -#' ADSL_mutated <- ADSL_dataset %>% -#' mutate_dataset(code = "ADSL$new_variable <- 1") -#' -#' ADSL_mutated$get_raw_data()$new_variable[1] -#' -#' # Use an R script to mutate the data -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "ADSL <- ADSL %>% -#' dplyr::mutate(new_variable = new_variable * 2)" -#' ), -#' con = file_example -#' ) -#' -#' ADSL_mutated <- ADSL_mutated %>% -#' mutate_dataset(script = file_example) -#' -#' ADSL_mutated$get_raw_data()$new_variable[1] -#' -#' ADSL_mutated <- ADSL_mutated %>% -#' mutate_dataset(code = read_script(file_example)) -#' -#' ADSL_mutated$get_raw_data()$new_variable[1] -#' @export -mutate_dataset.TealDataset <- function(x, - code = character(0), - script = character(0), - vars = list(), - ...) { - check_ellipsis(...) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - code <- code_from_script(code, script) - x$mutate(code = code, vars = vars, ...) -} - - -#' @rdname mutate_dataset -#' @export -mutate_dataset.TealDatasetConnector <- function(x, # nolint - code = character(0), - script = character(0), - vars = list(), - ...) { - check_ellipsis(...) - checkmate::assert_list(vars, min.len = 0, names = "unique") - code <- code_from_script(code, script) - x$mutate(code = code, vars = vars, ...) -} - - -#' @rdname mutate_dataset -#' @export -mutate_dataset.TealDataAbstract <- function(x, - dataname, - code = character(0), - script = character(0), - vars = list(), - ...) { - check_ellipsis(...) - checkmate::assert_list(vars, min.len = 0, names = "unique") - - code <- code_from_script(code, script) - x$mutate_dataset(dataname = dataname, code = code, vars = vars) -} - - - -#' Mutate data by code -#' -#' @description `r lifecycle::badge("experimental")` -#' Code used in this mutation is not linked to particular -#' but refers to all datasets. -#' Consequence of this is that when using `get_code()` this -#' part of the code will be returned for each dataset specified. This method -#' should be used only if particular call involve changing multiple datasets. -#' Otherwise please use `mutate_dataset`. -#' Execution of the code is delayed after datasets are pulled -#' (`isTRUE(is_pulled)`). -#' -#' @param x (`TealDataAbstract`)\cr -#' object. -#' @inheritParams mutate_dataset -#' -#' @return modified `x` object -#' -#' @export -mutate_data <- function(x, - code = character(0), - script = character(0), - vars = list()) { - UseMethod("mutate_data") -} - -#' @rdname mutate_data -#' @export -mutate_data.TealDataAbstract <- function(x, - code = character(0), - script = character(0), - vars = list()) { - checkmate::assert_list(vars, min.len = 0, names = "unique") - - code <- code_from_script(code, script) - x$mutate(code = code, vars = vars) - return(invisible(x)) -} diff --git a/R/set_args.R b/R/set_args.R deleted file mode 100644 index 6057963d2..000000000 --- a/R/set_args.R +++ /dev/null @@ -1,58 +0,0 @@ -#' Set arguments of a `CallableFunction` -#' -#' @description `r lifecycle::badge("stable")` -#' Set arguments of a `CallableFunction` -#' -#' @param x `CallableFunction` or `TealDatasetConnector`) -#' @param args (`NULL` or named `list`) dynamic arguments to function -#' -#' @return nothing -#' @rdname set_args -#' @export -set_args <- function(x, args) { - UseMethod("set_args") -} - -#' @rdname set_args -#' @export -#' @examples -#' ## Using CallableFunction -#' library(scda) -#' f <- function(df) { -#' synthetic_cdisc_data("latest")[[df]] -#' } -#' fun <- callable_function(f) -#' set_args(fun, list(df = "adsl")) -set_args.CallableFunction <- function(x, args) { - x$set_args(args) - return(invisible(x)) -} - -#' @rdname set_args -#' @export -#' @examples -#' ## Using CallableCode -#' library(scda) -#' f <- function(df) { -#' synthetic_cdisc_data("latest")[[df]] -#' } -#' code <- callable_code("f()") -#' set_args(code, list(df = "adsl")) -set_args.CallableCode <- function(x, args) { - warning( - "'CallableCode' is unchangable. Ignoring arguments set by 'set_args'", - call. = FALSE - ) - return(invisible(x)) -} - -#' @rdname set_args -#' @export -#' @examples -#' ## Using TealDatasetConnector -#' ds <- dataset_connector("x", pull_callable = callable_function(data.frame)) -#' set_args(ds, list(x = 1:5, y = letters[1:5])) -set_args.TealDatasetConnector <- function(x, args) { - x$set_args(args) - return(invisible(x)) -} diff --git a/R/tdata-constructors.r b/R/tdata-constructors.r new file mode 100644 index 000000000..9333e2f69 --- /dev/null +++ b/R/tdata-constructors.r @@ -0,0 +1,76 @@ +setOldClass("JoinKeys") + + +#' @export +setClass( + Class = "tdata", + contains = "qenv", + slots = c(join_keys = "JoinKeys", datanames = "character"), + prototype = list( + join_keys = join_keys(), + datanames = character(0) + ) +) + +#' Initialize `tdata` object +#' +#' Initialize `tdata` object. +#' @name new_tdata +#' +#' @param code (`character(1)` or `language`) code to evaluate. Accepts and stores comments also. +#' @param env (`list`) List of data. +#' +#' @examples +#' new_tdata(env = list(a = 1), code = quote(a <- 1)) +#' new_tdata(env = list(a = 1), code = parse(text = "a <- 1")) +#' new_tdatas(env = list(a = 1), code = "a <- 1") +#' +#' @export +setGeneric("new_tdata", function(env = new.env(), code = expression(), join_keys = join_keys()) { + standardGeneric("new_tdata") +}) + +#' @rdname new_tdata +#' @export +setMethod( + "new_tdata", + signature = c(env = "list", code = "expression", join_keys = "ANY"), + function(env, code, join_keys) { + new_env <- rlang::env_clone(list2env(env), parent = parent.env(.GlobalEnv)) + lockEnvironment(new_env, bindings = TRUE) + id <- sample.int(.Machine$integer.max, size = length(code)) + methods::new( + "tdata", + env = new_env, + code = code, + warnings = rep("", length(code)), + messages = rep("", length(code)), + id = id, + join_keys = join_keys, + datanames = union(names(env), names(join_keys$get())) + ) + } +) + +#' @rdname new_tdata +#' @export +setMethod( + "new_tdata", + signature = c(env = "list", code = "language", join_keys = "ANY"), + function(env, code, join_keys) { + code_expr <- as.expression(code) + new_tdata(env = env, code = code_expr, join_keys = join_keys) + } +) + +#' @rdname new_tdata +#' @export +setMethod( + "new_tdata", + signature = c(env = "list", code = "character", join_keys = "ANY"), + function(env, code, join_keys) { + code_expr <- parse(text = code) + new_tdata(env = env, code = code_expr, join_keys = join_keys) + } +) + diff --git a/R/teal_data.R b/R/teal_data.R index 2aab2abdc..ebffd431a 100644 --- a/R/teal_data.R +++ b/R/teal_data.R @@ -3,8 +3,7 @@ #' @description `r lifecycle::badge("stable")` #' Universal function to pass data to teal application #' -#' @param ... (`TealDataConnector`, `TealDataset`, `TealDatasetConnector`)\cr -#' objects +#' @param data (`list` named) #' @param join_keys (`JoinKeys`) or a single (`JoinKeySet`)\cr #' (optional) object with dataset column relationships used for joining. #' If empty then no joins between pairs of objects @@ -31,94 +30,16 @@ #' ) #' #' teal_data(x1, x2) -teal_data <- function(..., +teal_data <- function(data, join_keys = teal.data::join_keys(), code = "", check = FALSE) { - data_objects <- list(...) - checkmate::assert_list( - data_objects, - types = c("TealDataset", "TealDatasetConnector", "TealDataConnector") + # check_reproducibility() + # check_metadata + new_tdata( + env = data, + code = code, + join_keys = join_keys ) - if (inherits(join_keys, "JoinKeySet")) { - join_keys <- teal.data::join_keys(join_keys) - } - - update_join_keys_to_primary(data_objects, join_keys) - - x <- TealData$new(..., check = check, join_keys = join_keys) - - if (length(code) > 0 && !identical(code, "")) { - x$set_pull_code(code = code) - } - - x$check_reproducibility() - x$check_metadata() - - return(x) } - -#' Load `TealData` object from a file -#' -#' @description `r lifecycle::badge("experimental")` -#' Please note that the script has to end with a call creating desired object. The error will be raised otherwise. -#' -#' @param path A (`connection`) or a (`character`)\cr -#' string giving the pathname of the file or URL to read from. "" indicates the connection `stdin`. -#' @param code (`character`)\cr -#' reproducible code to re-create object -#' -#' @return `TealData` object -#' -#' -#' @export -#' -#' @examples -#' # simple example -#' file_example <- tempfile(fileext = ".R") -#' writeLines( -#' text = c( -#' "library(teal.data) -#' -#' x1 <- dataset(dataname = \"IRIS\", -#' x = iris, -#' code = \"IRIS <- iris\") -#' -#' x2 <- dataset(dataname = \"MTCARS\", -#' x = mtcars, -#' code = \"MTCARS <- mtcars\") -#' -#' teal_data(x1, x2)" -#' ), -#' con = file_example -#' ) -#' teal_data_file(file_example, code = character(0)) -teal_data_file <- function(path, code = get_code(path)) { - object <- object_file(path, "TealData") - object$mutate(code) - return(object) -} - -#' Add primary keys as join_keys to a dataset self -#' -#' @param data_objects (`list`) of `TealDataset`, `TealDatasetConnector` or `TealDataConnector` objects -#' @param join_keys (`JoinKeys`) object -#' -#' @keywords internal -update_join_keys_to_primary <- function(data_objects, join_keys) { - lapply(data_objects, function(obj) { - if (inherits(obj, "TealDataConnector")) { - update_join_keys_to_primary(obj$get_items(), join_keys) - } else { - dataname <- obj$get_dataname() - if (length(join_keys$get(dataname, dataname)) == 0) { - join_keys$mutate( - dataname, - dataname, - obj$get_keys() - ) - } - } - }) -} diff --git a/R/to_relational_data.R b/R/to_relational_data.R deleted file mode 100644 index 3cb132b67..000000000 --- a/R/to_relational_data.R +++ /dev/null @@ -1,128 +0,0 @@ -#' S3 generic for `to_relational_data` function. -#' -#' This function takes an object and converts into a `TealData` object, the primary data -#' object for use in teal applications. -#' -#' @param data `TealDataset`, `TealDatasetConnector`, `data.frame`, `MultiAssayExperiment`, `list` -#' or `function` returning a named list. -#' -#' @details Passing a `TealData` into this function leaves the object unchanged. -#' -#' @return `TealData` object -#' -#' @examples -#' -#' to_relational_data(head(iris)) -#' to_relational_data(dataset("IRIS", head(iris))) -#' to_relational_data(list(iris = head(iris), mtcars = head(mtcars))) -#' -#' d_connector <- dataset_connector("iris", callable_function(function() head(iris))) -#' d_connector$pull() -#' to_relational_data(d_connector) -#' -#' @keywords internal -#' @export -to_relational_data <- function(data) { - UseMethod("to_relational_data") -} - -#' @keywords internal -#' @export -to_relational_data.data.frame <- function(data) { # nolint - dataname <- deparse(substitute(data, parent.frame()), width.cutoff = 500L) - - if (grepl("\\)$", dataname) && inherits(data, "data.frame")) { - stop("Single data.frame shouldn't be provided as a result of a function call. Please name - the object first or use a named list.") - } - - if (dataname %in% names(default_cdisc_keys)) { - cdisc_data(cdisc_dataset(dataname, data)) - } else { - teal_data(dataset(dataname, data)) - } -} - -#' @keywords internal -#' @export -to_relational_data.TealDataset <- function(data) { - dataname <- get_dataname(data) - - if (dataname %in% names(default_cdisc_keys)) { - cdisc_data(data) - } else { - teal_data(data) - } -} - -#' @keywords internal -#' @export -to_relational_data.TealDatasetConnector <- function(data) { # nolint - to_relational_data.TealDataset(data) -} - -#' @keywords internal -#' @export -to_relational_data.list <- function(data) { - checkmate::assert_list( - data, - types = c("dataset", "data.frame", "MultiAssayExperiment", "TealDataset", "TealDatasetConnector") - ) - - call <- substitute(data, parent.frame()) - list_names <- names(data) - parsed_names <- as.character(call)[-1] - - if ( - ( - length(list_names) == 0 && - length(parsed_names) == 0 && - any(sapply(data, inherits, c("dataset", "data.frame", "MultiAssayExperiment"))) - ) || - (any(list_names == "") && length(parsed_names) == 0) || - (any(is.na(list_names))) - ) { - stop("Unnamed lists shouldn't be provided as input for data. Please use a named list.") - } - - datasets_list <- lapply( - seq_along(data), - function(idx) { - if (is.data.frame(data[[idx]]) || inherits(data[[idx]], "MultiAssayExperiment")) { - dataname <- if (length(list_names) == 0 || list_names[[idx]] == "") { - parsed_names[[idx]] - } else { - list_names[[idx]] - } - - if (dataname %in% names(default_cdisc_keys)) { - cdisc_dataset(dataname, data[[idx]]) - } else { - dataset(dataname, data[[idx]]) - } - } else if (inherits(data[[idx]], "TealDataset") || inherits(data[[idx]], "TealDatasetConnector")) { - data[[idx]] - } else { - stop("Unknown class to create TealDataset from.") - } - } - ) - - if (any(sapply(datasets_list, function(x) inherits(x, "CDISCTealDataset")))) { - do.call("cdisc_data", args = datasets_list) - } else { - do.call("teal_data", args = datasets_list) - } -} - -#' @keywords internal -#' @export -to_relational_data.MultiAssayExperiment <- function(data) { # nolint - teal_data(dataset("MAE", data)) -} - -#' @keywords internal -#' @export -to_relational_data.TealData <- function(data) { # nolint - data -} diff --git a/R/get_code.R b/R/utils-get_code.R similarity index 84% rename from R/get_code.R rename to R/utils-get_code.R index 733346692..d1a5abfc8 100644 --- a/R/get_code.R +++ b/R/utils-get_code.R @@ -34,75 +34,13 @@ #' @param ... not used, only for support of S3 #' @export #' @return (`character`) code of import and preparation of data for teal application. -get_code <- function(x, ...) { - UseMethod("get_code") -} - - -# Getting code from R6 ==== - -#' @export -#' @rdname get_code -get_code.TealDatasetConnector <- function(x, deparse = TRUE, ...) { - check_ellipsis(...) - x$get_code(deparse = deparse) -} - -#' @export -#' @rdname get_code -get_code.TealDataset <- function(x, deparse = TRUE, ...) { - check_ellipsis(...) - x$get_code(deparse = deparse) -} - - -#' @rdname get_code -#' @export -#' @examples -#' x1 <- dataset( -#' x = data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE), -#' keys = "y", -#' dataname = "XY", -#' code = "XY <- data.frame(x = c(1, 2), y = c('aa', 'bb'), stringsAsFactors = FALSE)", -#' label = character(0) -#' ) -#' -#' x2 <- dataset( -#' x = data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE), -#' keys = "y", -#' dataname = "XYZ", -#' code = "XYZ <- data.frame(x = c(1, 2), y = c('aa', 'bb'), stringsAsFactors = FALSE)", -#' label = character(0) -#' ) -#' -#' rd <- teal_data(x1, x2) -#' -#' get_code(rd) -#' get_code(rd, "XY") -#' get_code(rd, "XYZ") -get_code.TealDataAbstract <- function(x, dataname = character(0), deparse = TRUE, ...) { # nolint - check_ellipsis(...) - if (length(dataname) > 0) { - if (any(!(dataname %in% x$get_datanames()))) { - stop("The dataname provided does not exist") - } - x$get_code(dataname = dataname, deparse = deparse) - } else { - x$get_code(deparse = deparse) - } -} - -# Getting code from files ==== - -#' @rdname get_code -#' @export -get_code.default <- function(x, - exclude_comments = TRUE, - read_sources = TRUE, - deparse = FALSE, - files_path = NULL, - dataname = NULL, - ...) { +get_preprocessing_code <- function(x, + exclude_comments = TRUE, + read_sources = TRUE, + deparse = FALSE, + files_path = NULL, + dataname = NULL, + ...) { if (!is.null(files_path)) { x <- files_path } @@ -155,7 +93,7 @@ get_code.default <- function(x, #' Get code from specified file. #' @param file_path (`character`) path or URL address of the file to be parsed #' @param if_url (`logical`) (optional) TRUE when URL address is provided -#' @inheritParams get_code +#' @inheritParams get_preprocessing_code #' #' @return lines (`character`) of preprocessing code #' @keywords internal @@ -282,7 +220,7 @@ enclosed_with_dataname <- function(lines, dataname = NULL) { #' #' Excludes lines from code. It is possible to exclude one line ended by `# nocode` #' @inheritParams enclosed_with -#' @inheritParams get_code +#' @inheritParams get_preprocessing_code #' @inheritParams get_code_single #' @keywords internal code_exclude <- function(lines, exclude_comments, file_path) { diff --git a/R/topological_sort.R b/R/utils-topological_sort.R similarity index 100% rename from R/topological_sort.R rename to R/utils-topological_sort.R diff --git a/R/utils.R b/R/utils.R index ea2cf6b43..3663dc97f 100644 --- a/R/utils.R +++ b/R/utils.R @@ -5,7 +5,8 @@ #' #' @param code (`character`)\cr #' an R code to be evaluated or a `PythonCodeClass` created using [python_code]. -#' @inheritParams dataset_connector +#' @param script (`character`)\cr +#' path of the script #' @return code (`character`) #' @keywords internal code_from_script <- function(code, script, dataname = NULL) { diff --git a/_pkgdown.yml b/_pkgdown.yml index 95e2cc07d..bbf2ff040 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -118,3 +118,10 @@ reference: - TealDataConnector - TealDataset - TealDatasetConnector + - title: Functions for module developers + contents: + - tdata + - get_code_tdata + - get_join_keys + - get_metadata + - tdata2env diff --git a/man/CDISCTealDataConnector.Rd b/man/CDISCTealDataConnector.Rd deleted file mode 100644 index 27fc6562e..000000000 --- a/man/CDISCTealDataConnector.Rd +++ /dev/null @@ -1,108 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealDataConnector.R -\name{CDISCTealDataConnector} -\alias{CDISCTealDataConnector} -\title{Manage multiple and \code{TealDatasetConnector} of the same type.} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Class manages \code{TealDatasetConnector} to specify additional dynamic arguments and to -open/close connection. -} -\section{Super classes}{ -\code{\link[teal.data:TealDataAbstract]{teal.data::TealDataAbstract}} -> \code{\link[teal.data:TealDataConnector]{teal.data::TealDataConnector}} -> \code{CDISCTealDataConnector} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CDISCTealDataConnector-new}{\code{CDISCTealDataConnector$new()}} -\item \href{#method-CDISCTealDataConnector-get_parent}{\code{CDISCTealDataConnector$get_parent()}} -\item \href{#method-CDISCTealDataConnector-clone}{\code{CDISCTealDataConnector$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataConnector-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{CDISCTealDataConnector} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataConnector$new(connection, connectors)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{connection}}{(\code{TealDataConnection})\cr -connection to data source} - -\item{\code{connectors}}{(\code{list} of \code{TealDatasetConnector} elements)\cr -list with dataset connectors} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataConnector-get_parent}{}}} -\subsection{Method \code{get_parent()}}{ -Get all datasets parent names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataConnector$get_parent()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(named \code{list}) with dataset name and its corresponding parent dataset name -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataConnector-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataConnector$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/CDISCTealDataset.Rd b/man/CDISCTealDataset.Rd deleted file mode 100644 index e2d7b7f89..000000000 --- a/man/CDISCTealDataset.Rd +++ /dev/null @@ -1,261 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealDataset.R -\name{CDISCTealDataset} -\alias{CDISCTealDataset} -\title{R6 Class representing a dataset with parent attribute} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Any \code{data.frame} object can be stored inside this object. - -The difference compared to \code{TealDataset} class is a parent field that -indicates name of the parent dataset. Note that the parent field might -be empty (i.e. \code{character(0)}). -} -\examples{ -x <- cdisc_dataset( - dataname = "XYZ", - x = data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE), - keys = "y", - parent = "ABC", - code = "XYZ <- data.frame(x = c(1, 2), y = c('aa', 'bb'), - stringsAsFactors = FALSE)", - metadata = list(type = "example") -) - -x$ncol -x$get_code() -x$get_dataname() -x$get_keys() -x$get_parent() -} -\section{Super class}{ -\code{\link[teal.data:TealDataset]{teal.data::TealDataset}} -> \code{CDISCTealDataset} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CDISCTealDataset-new}{\code{CDISCTealDataset$new()}} -\item \href{#method-CDISCTealDataset-recreate}{\code{CDISCTealDataset$recreate()}} -\item \href{#method-CDISCTealDataset-get_attrs}{\code{CDISCTealDataset$get_attrs()}} -\item \href{#method-CDISCTealDataset-get_parent}{\code{CDISCTealDataset$get_parent()}} -\item \href{#method-CDISCTealDataset-set_parent}{\code{CDISCTealDataset$set_parent()}} -\item \href{#method-CDISCTealDataset-clone}{\code{CDISCTealDataset$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataset-new}{}}} -\subsection{Method \code{new()}}{ -Create a new object of \code{CDISCTealDataset} class -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataset$new( - dataname, - x, - keys, - parent, - code = character(0), - label = character(0), - vars = list(), - metadata = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{x}}{(\code{data.frame})\cr} - -\item{\code{keys}}{(\code{character})\cr -vector with primary keys} - -\item{\code{parent}}{optional, (\code{character}) \cr -parent dataset name} - -\item{\code{code}}{(\code{character})\cr -A character string defining the code needed to produce the data set in \code{x}} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It is recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list} or \code{NULL}) \cr -Field containing metadata about the dataset. Each element of the list -should be atomic and length one.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataset-recreate}{}}} -\subsection{Method \code{recreate()}}{ -Recreate a dataset with its current attributes -This is useful way to have access to class initialize method basing on class object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataset$recreate( - dataname = self$get_dataname(), - x = self$get_raw_data(), - keys = self$get_keys(), - parent = self$get_parent(), - code = private$code, - label = self$get_dataset_label(), - vars = list(), - metadata = self$get_metadata() -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{x}}{(\code{data.frame})\cr} - -\item{\code{keys}}{(\code{character})\cr -vector with primary keys} - -\item{\code{parent}}{optional, (\code{character}) \cr -parent dataset name} - -\item{\code{code}}{(\code{character})\cr -A character string defining the code needed to produce the data set in \code{x}} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It is recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list} or \code{NULL}) \cr -Field containing metadata about the dataset. Each element of the list -should be atomic and length one.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a new object of \code{CDISCTealDataset} class -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataset-get_attrs}{}}} -\subsection{Method \code{get_attrs()}}{ -Get all dataset attributes -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataset$get_attrs()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(named \code{list}) with dataset attributes -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataset-get_parent}{}}} -\subsection{Method \code{get_parent()}}{ -Get parent dataset name -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataset$get_parent()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{character}) indicating parent dataname -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataset-set_parent}{}}} -\subsection{Method \code{set_parent()}}{ -Set parent dataset name -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataset$set_parent(parent)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{parent}}{(\code{character}) indicating parent dataname} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDataset-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDataset$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/CDISCTealDatasetConnector.Rd b/man/CDISCTealDatasetConnector.Rd deleted file mode 100644 index e33763542..000000000 --- a/man/CDISCTealDatasetConnector.Rd +++ /dev/null @@ -1,181 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealDatasetConnector.R -\name{CDISCTealDatasetConnector} -\alias{CDISCTealDatasetConnector} -\title{A \code{CDISCTealDatasetConnector} class of objects} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Objects of this class store the connection function to fetch a single dataset. - -The difference compared to \code{TealDatasetConnector} is a parent field that -indicates name of the parent dataset. Note that the parent field might -be empty (i.e. \code{character(0)}). -} -\section{Super class}{ -\code{\link[teal.data:TealDatasetConnector]{teal.data::TealDatasetConnector}} -> \code{CDISCTealDatasetConnector} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CDISCTealDatasetConnector-new}{\code{CDISCTealDatasetConnector$new()}} -\item \href{#method-CDISCTealDatasetConnector-get_parent}{\code{CDISCTealDatasetConnector$get_parent()}} -\item \href{#method-CDISCTealDatasetConnector-pull}{\code{CDISCTealDatasetConnector$pull()}} -\item \href{#method-CDISCTealDatasetConnector-clone}{\code{CDISCTealDatasetConnector$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDatasetConnector-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{TealDatasetConnector} object. Set the pulling function -\code{CallableFunction} which returns a \code{data.frame}, e.g. by reading -from a function or creating it on the fly. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDatasetConnector$new( - dataname, - pull_callable, - keys, - parent, - code = character(0), - label = character(0), - vars = list(), - metadata = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{pull_callable}}{(\code{CallableFunction})\cr -function with necessary arguments set to fetch data from connection.} - -\item{\code{keys}}{(\code{character})\cr -vector of dataset primary keys column names} - -\item{\code{parent}}{optional, (\code{character}) \cr -parent dataset name} - -\item{\code{code}}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset.} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDatasetConnector-get_parent}{}}} -\subsection{Method \code{get_parent()}}{ -Get parent dataset name -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDatasetConnector$get_parent()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{character}) indicating parent dataname -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDatasetConnector-pull}{}}} -\subsection{Method \code{pull()}}{ -Pull the data - -Read or create the data using \code{pull_callable} specified in the constructor. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDatasetConnector$pull(args = NULL, try = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -additional dynamic arguments for pull function. \code{args} can be omitted if \code{pull_callable} -from constructor already contains all necessary arguments to pull data. One can try -to execute \code{pull_callable} directly by \code{x$pull_callable$run()} or to get code using -\code{x$pull_callable$get_code()}. \code{args} specified in pull are used temporary to get data but -not saved in code.} - -\item{\code{try}}{(\code{logical} value)\cr -whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{self} invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealDatasetConnector-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealDatasetConnector$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/Callable.Rd b/man/Callable.Rd deleted file mode 100644 index 83a2b6791..000000000 --- a/man/Callable.Rd +++ /dev/null @@ -1,145 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/Callable.R -\name{Callable} -\alias{Callable} -\title{A \code{Callable} class of objects} -\description{ -Object that stores function name with its arguments. Methods to get call and run it. -} -\keyword{internal} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-Callable-new}{\code{Callable$new()}} -\item \href{#method-Callable-assign_to_env}{\code{Callable$assign_to_env()}} -\item \href{#method-Callable-run}{\code{Callable$run()}} -\item \href{#method-Callable-is_failed}{\code{Callable$is_failed()}} -\item \href{#method-Callable-get_error_message}{\code{Callable$get_error_message()}} -\item \href{#method-Callable-clone}{\code{Callable$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Callable-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{CallableCode} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Callable$new(env)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{env}}{(\code{environment})\cr -environment where the call will be evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -new \code{CallableCode} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Callable-assign_to_env}{}}} -\subsection{Method \code{assign_to_env()}}{ -Assigns \code{x <- value} object to \code{env}. Assigned object can't -be modified within local environment as it will be locked by using -\code{lockBinding}. This also means that this object can't be reassigned -which will throw an error. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Callable$assign_to_env(x, value)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{x}}{(\code{character} value)\cr -name of the variable in class environment} - -\item{\code{value}}{(\code{data.frame})\cr -object to be assigned to \code{x}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Callable-run}{}}} -\subsection{Method \code{run()}}{ -Execute \code{Callable} function or code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Callable$run(return = TRUE, args = NULL, try = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{return}}{(\code{logical} value)\cr -whether to return an object} - -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -supplied for callable functions only, these are dynamic arguments passed to function. -Dynamic arguments are executed in this call and are not saved which means that -\code{self$get_call()} won't include them later.} - -\item{\code{try}}{(\code{logical} value)\cr -whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -nothing or output from function depending on \code{return} -argument. If \code{run} fails it will return object of class \code{simple-error error} -when \code{try = TRUE} or will stop if \code{try = FALSE}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Callable-is_failed}{}}} -\subsection{Method \code{is_failed()}}{ -Check if evaluation of the function has not failed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Callable$is_failed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{logical}) \code{TRUE} if evaluation of the function failed or \code{FALSE} -if evaluation failed or function hasn't yet been called. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Callable-get_error_message}{}}} -\subsection{Method \code{get_error_message()}}{ -Get error message from last function execution -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Callable$get_error_message()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{character}) object with error message or \code{character(0)} if last -function evaluation was successful. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-Callable-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{Callable$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/CallableCode.Rd b/man/CallableCode.Rd deleted file mode 100644 index 6ffe21b3d..000000000 --- a/man/CallableCode.Rd +++ /dev/null @@ -1,98 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallableCode.R -\name{CallableCode} -\alias{CallableCode} -\title{A \code{CallableCode} class of objects} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Object that stores code to reproduce an object. It includes methods to -get or run the code and return the object. -} -\section{Super class}{ -\code{\link[teal.data:Callable]{teal.data::Callable}} -> \code{CallableCode} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CallableCode-new}{\code{CallableCode$new()}} -\item \href{#method-CallableCode-get_call}{\code{CallableCode$get_call()}} -\item \href{#method-CallableCode-clone}{\code{CallableCode$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableCode-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{CallableCode} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableCode$new(code, env = new.env(parent = parent.env(globalenv())))}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{(\code{character})\cr -a string containing R code to reproduce the desired object.} - -\item{\code{env}}{(\code{environment})\cr -environment where function will be evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -new \code{CallableCode} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableCode-get_call}{}}} -\subsection{Method \code{get_call()}}{ -Get sequence of calls from the code supplied to produce the object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableCode$get_call(deparse = TRUE, args = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deparse}}{(\code{logical} value)\cr -whether to return a deparsed version of call} - -\item{\code{args}}{(\code{NULL})\cr -available to be consistent with \code{CallableFunction} but are not used to -retrieve the call.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{list} of \code{calls} or \code{character} depending on \code{deparse} argument -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableCode-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableCode$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/CallableFunction.Rd b/man/CallableFunction.Rd deleted file mode 100644 index 22afa6b3a..000000000 --- a/man/CallableFunction.Rd +++ /dev/null @@ -1,160 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallableFunction.R -\name{CallableFunction} -\alias{CallableFunction} -\title{A \code{CallableFunction} class of objects} -\description{ -Object that stores a function name together with its arguments. -Methods are then available to get the function call and evaluate it. -} -\keyword{internal} -\section{Super class}{ -\code{\link[teal.data:Callable]{teal.data::Callable}} -> \code{CallableFunction} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CallableFunction-new}{\code{CallableFunction$new()}} -\item \href{#method-CallableFunction-get_args}{\code{CallableFunction$get_args()}} -\item \href{#method-CallableFunction-get_call}{\code{CallableFunction$get_call()}} -\item \href{#method-CallableFunction-set_args}{\code{CallableFunction$set_args()}} -\item \href{#method-CallableFunction-set_arg_value}{\code{CallableFunction$set_arg_value()}} -\item \href{#method-CallableFunction-clone}{\code{CallableFunction$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableFunction-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{CallableFunction} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableFunction$new(fun, env = new.env(parent = parent.env(globalenv())))}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{fun}}{(\code{function})\cr -function to be evaluated in class. -This is either a \code{function} object or its name as a string.} - -\item{\code{env}}{(\code{environment})\cr -environment where function will be evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -new \code{CallableFunction} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableFunction-get_args}{}}} -\subsection{Method \code{get_args()}}{ -get the arguments a function gets called with -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableFunction$get_args()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -arguments the function gets called with -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableFunction-get_call}{}}} -\subsection{Method \code{get_call()}}{ -Get function call with substituted arguments in \code{args}. -These arguments will not be stored in the object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableFunction$get_call(deparse = TRUE, args = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deparse}}{(\code{logical} value)\cr -whether to return a deparsed version of call} - -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -dynamic arguments to function} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{call} or \code{character} depending on \code{deparse} argument -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableFunction-set_args}{}}} -\subsection{Method \code{set_args()}}{ -Set up function arguments -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableFunction$set_args(args)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -function arguments to be stored persistently in the object. Setting \code{args} doesn't -remove other \code{args}, only create new of modify previous of the same name. -To clean arguments specify \code{args = NULL}.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableFunction-set_arg_value}{}}} -\subsection{Method \code{set_arg_value()}}{ -Set up single function argument with value -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableFunction$set_arg_value(name, value)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{name}}{(\code{character}) argument name} - -\item{\code{value}}{argument value} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallableFunction-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallableFunction$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/CallablePythonCode.Rd b/man/CallablePythonCode.Rd deleted file mode 100644 index bf7567945..000000000 --- a/man/CallablePythonCode.Rd +++ /dev/null @@ -1,130 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallablePythonCode.R -\name{CallablePythonCode} -\alias{CallablePythonCode} -\title{A \code{CallablePythonCode} class of objects} -\description{ -A \code{CallablePythonCode} class of objects - -A \code{CallablePythonCode} class of objects -} -\keyword{internal} -\section{Super classes}{ -\code{\link[teal.data:Callable]{teal.data::Callable}} -> \code{\link[teal.data:CallableFunction]{teal.data::CallableFunction}} -> \code{CallablePythonCode} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CallablePythonCode-new}{\code{CallablePythonCode$new()}} -\item \href{#method-CallablePythonCode-set_object}{\code{CallablePythonCode$set_object()}} -\item \href{#method-CallablePythonCode-run}{\code{CallablePythonCode$run()}} -\item \href{#method-CallablePythonCode-clone}{\code{CallablePythonCode$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallablePythonCode-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{CallablePythonCode} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallablePythonCode$new(fun, env = new.env(parent = parent.env(globalenv())))}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{fun}}{(\code{function})\cr -function to be evaluated in class. Function should be named} - -\item{\code{env}}{(\code{environment})\cr -environment where the result of python code evaluation are stored} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -new \code{CallablePythonCode} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallablePythonCode-set_object}{}}} -\subsection{Method \code{set_object()}}{ -For scripts and code that contain multiple objects, save the name -of the object that corresponds to the final dataset of interest. -This is required for running python scripts with \code{reticulate}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallablePythonCode$set_object(x)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{x}}{(\code{character}) the name of the object produced by the code -or script.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallablePythonCode-run}{}}} -\subsection{Method \code{run()}}{ -Execute \code{Callable} python code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallablePythonCode$run(args = NULL, try = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -supplied for callable functions only, these are dynamic arguments passed to -\code{reticulate::py_run_string} or \code{reticulate::py_run_file}. Dynamic arguments -are executed in this call and are not saved which means that \code{self$get_call()} -won't include them later.} - -\item{\code{try}}{(\code{logical} value)\cr -whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -nothing or output from function depending on \code{return} -argument. If \code{run} fails it will return object of class \code{simple-error} error -when \code{try = TRUE} or will stop if \code{try = FALSE}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CallablePythonCode-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CallablePythonCode$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/CodeClass.Rd b/man/CodeClass.Rd index 751bd9437..6b6c7e142 100644 --- a/man/CodeClass.Rd +++ b/man/CodeClass.Rd @@ -10,12 +10,12 @@ Code Class } \examples{ cc <- teal.data:::CodeClass$new() -cc$set_code(c("foo <- function() {1}", "foo2 <- function() {2}")) +cc$set_code(c("ddl_run <- function() {1}", "ddl_run2 <- function() {2}")) cc$get_code() cc$get_code(deparse = FALSE) cc$set_code(c("DF <- data.frame(x = 1:10)", "DF$y <- 1"), "DF") -cc$set_code("DF$a <- foo()", "DF") +cc$set_code("DF$a <- ddl_run()", "DF") # dependent dataset cc$set_code(c("DF2 <- data.frame(x2 = 1:10)", "DF2$y2 <- DF$y"), "DF2", deps = "DF") @@ -53,7 +53,7 @@ x$append(x3) x$get_code("DF3") # mutation simulation -x$set_code("DF3$x <- foo(DF$x)", "DF3", deps = "DF") +x$set_code("DF3$x <- ddl_run(DF$x)", "DF3", deps = "DF") x$get_code("DF3") } \keyword{internal} diff --git a/man/MAETealDataset.Rd b/man/MAETealDataset.Rd deleted file mode 100644 index 9acd941fc..000000000 --- a/man/MAETealDataset.Rd +++ /dev/null @@ -1,257 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/MAETealDataset.R -\name{MAETealDataset} -\alias{MAETealDataset} -\title{R6 Class representing a \code{MultiAssayExperiment} object with its attributes} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Any \code{MultiAssayExperiment} object can be stored inside this \code{MAETealDataset}. -Some attributes like colnames, dimension or column names for a specific type will -be automatically derived. -} -\seealso{ -\code{\link{TealDataset}} -} -\section{Super class}{ -\code{\link[teal.data:TealDataset]{teal.data::TealDataset}} -> \code{MAETealDataset} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-MAETealDataset-new}{\code{MAETealDataset$new()}} -\item \href{#method-MAETealDataset-check}{\code{MAETealDataset$check()}} -\item \href{#method-MAETealDataset-check_keys}{\code{MAETealDataset$check_keys()}} -\item \href{#method-MAETealDataset-get_colnames}{\code{MAETealDataset$get_colnames()}} -\item \href{#method-MAETealDataset-get_column_labels}{\code{MAETealDataset$get_column_labels()}} -\item \href{#method-MAETealDataset-get_ncol}{\code{MAETealDataset$get_ncol()}} -\item \href{#method-MAETealDataset-get_nrow}{\code{MAETealDataset$get_nrow()}} -\item \href{#method-MAETealDataset-get_rownames}{\code{MAETealDataset$get_rownames()}} -\item \href{#method-MAETealDataset-print}{\code{MAETealDataset$print()}} -\item \href{#method-MAETealDataset-clone}{\code{MAETealDataset$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-new}{}}} -\subsection{Method \code{new()}}{ -Create a new object of \code{MAETealDataset} class -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$new( - dataname, - x, - keys = character(0), - code = character(0), - label = character(0), - vars = list(), - metadata = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{x}}{(\code{MultiAssayExperiment})\cr} - -\item{\code{keys}}{optional, (\code{character})\cr -A vector of primary keys} - -\item{\code{code}}{(\code{character} or \code{CodeClass})\cr -A character string defining the code needed to produce the data set in \code{x}. -initialize()\code{and}recreate()\verb{accept code as}CodeClass` -which is also needed to preserve the code uniqueness and correct order.} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It is recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list} or \code{NULL}) \cr -Field containing metadata about the dataset. Each element of the list -should be atomic and of length one.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-check}{}}} -\subsection{Method \code{check()}}{ -Check to determine if the raw data is reproducible from the \code{get_code()} code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$check()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if the dataset generated from evaluating the -\code{get_code()} code is identical to the raw data, else \code{FALSE}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-check_keys}{}}} -\subsection{Method \code{check_keys()}}{ -Check if keys has been specified correctly for dataset. Set of \code{keys} -should distinguish unique rows or be \code{character(0)}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$check_keys(keys = private$.keys)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{keys}}{optional, (\code{character})\cr -A vector of primary keys} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{TRUE} if dataset has been already pulled, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-get_colnames}{}}} -\subsection{Method \code{get_colnames()}}{ -Derive the column names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$get_colnames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-get_column_labels}{}}} -\subsection{Method \code{get_column_labels()}}{ -Derive the column labels -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$get_column_labels()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-get_ncol}{}}} -\subsection{Method \code{get_ncol()}}{ -Get the number of columns of the data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$get_ncol()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{numeric} vector -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-get_nrow}{}}} -\subsection{Method \code{get_nrow()}}{ -Get the number of rows of the data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$get_nrow()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{numeric} vector -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-get_rownames}{}}} -\subsection{Method \code{get_rownames()}}{ -Derive the row names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$get_rownames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-print}{}}} -\subsection{Method \code{print()}}{ -Prints this \code{MAETealDataset}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$print(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{additional arguments to the printing method} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -invisibly self -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-MAETealDataset-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{MAETealDataset$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/PythonCodeClass.Rd b/man/PythonCodeClass.Rd deleted file mode 100644 index 0949131cb..000000000 --- a/man/PythonCodeClass.Rd +++ /dev/null @@ -1,74 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallablePythonCode.R -\name{PythonCodeClass} -\alias{PythonCodeClass} -\title{A \code{CallablePythonCode} class of objects} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -} -\section{Super class}{ -\code{\link[teal.data:CodeClass]{teal.data::CodeClass}} -> \code{PythonCodeClass} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-PythonCodeClass-eval}{\code{PythonCodeClass$eval()}} -\item \href{#method-PythonCodeClass-clone}{\code{PythonCodeClass$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PythonCodeClass-eval}{}}} -\subsection{Method \code{eval()}}{ -Evaluates internal code within environment -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PythonCodeClass$eval( - vars = list(), - dataname = NULL, - envir = new.env(parent = parent.env(.GlobalEnv)) -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{vars}}{(named \code{list}) additional pre-requisite vars to execute code} - -\item{\code{dataname}}{(\code{character}) name of the data frame object to be returned} - -\item{\code{envir}}{(\code{environment}) environment in which code will be evaluated} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{data.frame} containing the mutated dataset -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-PythonCodeClass-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{PythonCodeClass$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/TealData.Rd b/man/TealData.Rd deleted file mode 100644 index 9801797f6..000000000 --- a/man/TealData.Rd +++ /dev/null @@ -1,334 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealData.R -\name{TealData} -\alias{TealData} -\title{Manage multiple \code{TealDataConnector}, \code{TealDatasetConnector} and \code{TealDataset} objects.} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Class manages \code{TealDataConnector}, \code{TealDatasetConnector} and -\code{TealDataset} objects and aggregate them in one collection. -Class also decides whether to launch app before initialize teal application. -} -\examples{ -library(scda) -adsl_cf <- callable_function(function() synthetic_cdisc_data("latest")$adsl) -adlb_cf <- callable_function(function() synthetic_cdisc_data("latest")$adlb) -adrs_cf <- callable_function(function() synthetic_cdisc_data("latest")$adrs) -adtte_cf <- callable_function(function() synthetic_cdisc_data("latest")$adtte) -x1 <- cdisc_dataset_connector("ADSL", adsl_cf, keys = get_cdisc_keys("ADSL")) -x2 <- cdisc_dataset_connector("ADRS", adrs_cf, keys = get_cdisc_keys("ADRS")) -x3 <- cdisc_dataset( - dataname = "ADAE", - x = synthetic_cdisc_data("latest")$adae, - code = "library(scda)\nADAE <- synthetic_cdisc_data(\"latest\")$adae" -) -x4 <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE")) -tc <- teal.data:::TealData$new(x1, x2, x3, x4) -tc$get_datanames() -\dontrun{ -tc$launch() -get_datasets(tc) # equivalent to tc$get_datasets() -tc$get_dataset("ADAE") -tc$check() -} - -x <- cdisc_dataset( - dataname = "ADSL", - x = synthetic_cdisc_data("latest")$adsl, - code = "library(scda)\nADSL <- synthetic_cdisc_data(\"latest\")$adsl" -) - -x2 <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE")) -tc <- teal.data:::TealData$new(x, x2) -\dontrun{ -# This errors as we have not pulled the data -# tc$get_datasets() -# pull the data and then we can get the datasets -tc$launch() -tc$get_datasets() -get_raw_data(tc) -} - -} -\section{Super class}{ -\code{\link[teal.data:TealDataAbstract]{teal.data::TealDataAbstract}} -> \code{TealData} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealData-new}{\code{TealData$new()}} -\item \href{#method-TealData-copy}{\code{TealData$copy()}} -\item \href{#method-TealData-print}{\code{TealData$print()}} -\item \href{#method-TealData-get_connectors}{\code{TealData$get_connectors()}} -\item \href{#method-TealData-get_items}{\code{TealData$get_items()}} -\item \href{#method-TealData-get_join_keys}{\code{TealData$get_join_keys()}} -\item \href{#method-TealData-get_parents}{\code{TealData$get_parents()}} -\item \href{#method-TealData-get_ui}{\code{TealData$get_ui()}} -\item \href{#method-TealData-get_server}{\code{TealData$get_server()}} -\item \href{#method-TealData-launch}{\code{TealData$launch()}} -\item \href{#method-TealData-mutate_join_keys}{\code{TealData$mutate_join_keys()}} -\item \href{#method-TealData-check_metadata}{\code{TealData$check_metadata()}} -\item \href{#method-TealData-clone}{\code{TealData$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-new}{}}} -\subsection{Method \code{new()}}{ -Create a new object of \code{TealData} class -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$new(..., check = FALSE, join_keys = teal.data::join_keys())}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{(\code{TealDataConnector}, \code{TealDataset}, \code{TealDatasetConnector})\cr -objects} - -\item{\code{check}}{(\code{logical}) reproducibility check - whether evaluated preprocessing code gives the same objects -as provided in arguments. Check is run only if flag is true and preprocessing code is not empty.} - -\item{\code{join_keys}}{(\code{JoinKeys}) or a single (\code{JoinKeySet})\cr -(optional) object with dataset column relationships used for joining. -If empty then an empty \code{JoinKeys} object is passed by default.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-copy}{}}} -\subsection{Method \code{copy()}}{ -Creates a copy of the object with keeping valid references -between \code{TealDataset} and \code{TealDatasetConnector} objects -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$copy(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{(\code{logical(1)})\cr -argument passed to \code{clone} method. If \code{TRUE} deep copy is made} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -self invisible -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-print}{}}} -\subsection{Method \code{print()}}{ -Prints this \code{TealData}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$print(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{additional arguments to the printing method} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -invisibly self -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_connectors}{}}} -\subsection{Method \code{get_connectors()}}{ -Get data connectors. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$get_connectors()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{list}) with all \code{TealDatasetConnector} or \code{TealDataConnector} objects. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_items}{}}} -\subsection{Method \code{get_items()}}{ -Get all datasets and all dataset connectors -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$get_items(dataname = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character} value)\cr -name of dataset connector to be returned. If \code{NULL}, all connectors are returned.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{list} with all datasets and all connectors -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_join_keys}{}}} -\subsection{Method \code{get_join_keys()}}{ -Get join keys between two datasets. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$get_join_keys(dataset_1, dataset_2)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataset_1}}{(\code{character}) name of first dataset.} - -\item{\code{dataset_2}}{(\code{character}) name of second dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{character}) named character vector x with names(x) the -columns of \code{dataset_1} and the values of \code{(x)} the corresponding join -keys in \code{dataset_2} or \code{character(0)} if no relationship -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_parents}{}}} -\subsection{Method \code{get_parents()}}{ -returns the parents list of the datasets. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$get_parents()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -named (\code{list}) of the parents of all datasets. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_ui}{}}} -\subsection{Method \code{get_ui()}}{ -Get a shiny-module UI to render the necessary app to -derive \code{TealDataConnector} object's data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$get_ui(id)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{(\code{character}) item ID for the shiny module} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -the \code{shiny} \code{ui} function -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_server}{}}} -\subsection{Method \code{get_server()}}{ -Get a shiny-module server to render the necessary app to -derive \code{TealDataConnector} object's data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$get_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{shiny} server module. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-launch}{}}} -\subsection{Method \code{launch()}}{ -Launch an app that allows to run the user-interfaces of all -\code{TealDataConnector} and \code{TealDatasetConnector} modules - -This piece is mainly used for debugging. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$launch()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-mutate_join_keys}{}}} -\subsection{Method \code{mutate_join_keys()}}{ -Change join_keys for a given pair of dataset names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$mutate_join_keys(dataset_1, dataset_2, val)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataset_1, dataset_2}}{(\code{character}) datasets for which join_keys are to be returned} - -\item{\code{val}}{(named \code{character}) column names used to join} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-check_metadata}{}}} -\subsection{Method \code{check_metadata()}}{ -Check there is consistency between the datasets and join_keys -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$check_metadata()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -raise and error or invisible \code{TRUE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealData$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/TealDataAbstract.Rd b/man/TealDataAbstract.Rd deleted file mode 100644 index 104e9abf8..000000000 --- a/man/TealDataAbstract.Rd +++ /dev/null @@ -1,389 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataAbstract.R -\name{TealDataAbstract} -\alias{TealDataAbstract} -\title{\code{TealDataAbstract} class} -\description{ -Abstract class containing code for handling set of datasets. -} -\keyword{internal} -\section{Public fields}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{String used to create unique GUI elements} -} -\if{html}{\out{
}} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealDataAbstract-new}{\code{TealDataAbstract$new()}} -\item \href{#method-TealDataAbstract-check}{\code{TealDataAbstract$check()}} -\item \href{#method-TealDataAbstract-check_reproducibility}{\code{TealDataAbstract$check_reproducibility()}} -\item \href{#method-TealDataAbstract-execute_mutate}{\code{TealDataAbstract$execute_mutate()}} -\item \href{#method-TealDataAbstract-get_check_result}{\code{TealDataAbstract$get_check_result()}} -\item \href{#method-TealDataAbstract-get_code}{\code{TealDataAbstract$get_code()}} -\item \href{#method-TealDataAbstract-get_code_class}{\code{TealDataAbstract$get_code_class()}} -\item \href{#method-TealDataAbstract-get_datanames}{\code{TealDataAbstract$get_datanames()}} -\item \href{#method-TealDataAbstract-get_dataset}{\code{TealDataAbstract$get_dataset()}} -\item \href{#method-TealDataAbstract-get_datasets}{\code{TealDataAbstract$get_datasets()}} -\item \href{#method-TealDataAbstract-get_items}{\code{TealDataAbstract$get_items()}} -\item \href{#method-TealDataAbstract-get_check}{\code{TealDataAbstract$get_check()}} -\item \href{#method-TealDataAbstract-is_pulled}{\code{TealDataAbstract$is_pulled()}} -\item \href{#method-TealDataAbstract-mutate}{\code{TealDataAbstract$mutate()}} -\item \href{#method-TealDataAbstract-mutate_dataset}{\code{TealDataAbstract$mutate_dataset()}} -\item \href{#method-TealDataAbstract-set_check}{\code{TealDataAbstract$set_check()}} -\item \href{#method-TealDataAbstract-set_pull_code}{\code{TealDataAbstract$set_pull_code()}} -\item \href{#method-TealDataAbstract-reassign_datasets_vars}{\code{TealDataAbstract$reassign_datasets_vars()}} -\item \href{#method-TealDataAbstract-clone}{\code{TealDataAbstract$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-new}{}}} -\subsection{Method \code{new()}}{ -Cannot create a \code{TealDataAbstract} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$new()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -throws error -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-check}{}}} -\subsection{Method \code{check()}}{ -Check if the object raw data is reproducible from the \code{get_code()} code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$check()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{NULL} if check step has been disabled -\code{TRUE} if all the datasets generated from evaluating the -\code{get_code()} code are identical to the raw data, else \code{FALSE}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-check_reproducibility}{}}} -\subsection{Method \code{check_reproducibility()}}{ -Execute \code{check()} and raise an error if it's not reproducible. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$check_reproducibility()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -error if code is not reproducible else invisibly nothing -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-execute_mutate}{}}} -\subsection{Method \code{execute_mutate()}}{ -Execute mutate code. Using \verb{mutate_data(set).TealDataAbstract} -does not cause instant execution, the \code{mutate_code} is -delayed and can be evaluated using this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$execute_mutate()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_check_result}{}}} -\subsection{Method \code{get_check_result()}}{ -Get result of reproducibility check -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_check_result()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{NULL} if check has not been called yet, \code{TRUE} / \code{FALSE} otherwise -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_code}{}}} -\subsection{Method \code{get_code()}}{ -Get code for all datasets. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_code(dataname = NULL, deparse = TRUE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character}) dataname or \code{NULL} for all datasets} - -\item{\code{deparse}}{(\code{logical}) whether to return the deparsed form of a call} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{character}) vector of code to generate datasets. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_code_class}{}}} -\subsection{Method \code{get_code_class()}}{ -Get internal \code{CodeClass} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_code_class(only_pull = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{only_pull}}{(\code{logical} value)\cr -if \code{TRUE} only code to pull datasets will be returned without the mutate code.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{CodeClass} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_datanames}{}}} -\subsection{Method \code{get_datanames()}}{ -Get names of the datasets. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_datanames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector with names of all datasets. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_dataset}{}}} -\subsection{Method \code{get_dataset()}}{ -Get \code{TealDataset} object. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_dataset(dataname = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character} value)\cr -name of dataset to be returned. If \code{NULL}, all datasets are returned.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{TealDataset}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_datasets}{}}} -\subsection{Method \code{get_datasets()}}{ -Get \code{list} of \code{TealDataset} objects. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_datasets()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{list} of \code{TealDataset}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_items}{}}} -\subsection{Method \code{get_items()}}{ -Get all datasets and all dataset connectors -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_items(dataname = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character} value)\cr -name of dataset connector to be returned. If \code{NULL}, all connectors are returned.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{list} with all datasets and all connectors -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-get_check}{}}} -\subsection{Method \code{get_check()}}{ -Has this data been or will this data be subjected to a reproducibility check -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$get_check()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{logical} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-is_pulled}{}}} -\subsection{Method \code{is_pulled()}}{ -Check if dataset has already been pulled. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$is_pulled()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if dataset has been already pulled, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-mutate}{}}} -\subsection{Method \code{mutate()}}{ -Mutate data by code. Code used in this mutation is not linked to particular -but refers to all datasets. -Consequence of this is that when using \verb{get_code()} this -part of the code will be returned for each specified dataset. This method -should be used only if particular call involve changing multiple datasets. -Otherwise please use \code{mutate_dataset}. -Execution of \code{mutate_code} is delayed after datasets are pulled -(\code{isTRUE(is_pulled)}). -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$mutate(code, vars = list())}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{(\code{character}) Code to mutate the dataset. Must contain the -\code{dataset$dataname}} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -self invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-mutate_dataset}{}}} -\subsection{Method \code{mutate_dataset()}}{ -Mutate dataset by code. -Execution of \code{mutate_code} is delayed after datasets are pulled -(\code{isTRUE(is_pulled)}). -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$mutate_dataset(dataname, code, vars = list())}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character}) Dataname to be mutated} - -\item{\code{code}}{(\code{character}) Code to mutate the dataset. Must contain the -\code{dataset$dataname}} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -self invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-set_check}{}}} -\subsection{Method \code{set_check()}}{ -Set reproducibility check -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$set_check(check = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{check}}{(\code{logical}) whether to perform reproducibility check.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-set_pull_code}{}}} -\subsection{Method \code{set_pull_code()}}{ -Set pull code -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$set_pull_code(code)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{(\code{character} value)\cr -code to reproduce \code{data} in \code{TealDataset} objects. Can't be set if any dataset -has \code{code} set already.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-reassign_datasets_vars}{}}} -\subsection{Method \code{reassign_datasets_vars()}}{ -Reassign \code{vars} in \code{TealDataset} and \code{TealDatasetConnector} objects -to keep the valid reference after deep cloning -For example if \code{TealDatasetConnector} has a dependency on some \code{TealDataset}, this -\code{TealDataset} is reassigned inside of \code{TealDatasetConnector}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$reassign_datasets_vars()}\if{html}{\out{
}} -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataAbstract-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataAbstract$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/TealDataConnection.Rd b/man/TealDataConnection.Rd deleted file mode 100644 index cbc241d67..000000000 --- a/man/TealDataConnection.Rd +++ /dev/null @@ -1,563 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataConnection.R -\name{TealDataConnection} -\alias{TealDataConnection} -\title{A \code{TealDataConnection} class of objects} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -Objects of this class store the connection to a data source. -It can be a database or server connection. -} -\examples{ -open_fun <- callable_function(data.frame) # define opening function -open_fun$set_args(list(x = 1:5)) # define fixed arguments to opening function - -close_fun <- callable_function(sum) # define closing function -close_fun$set_args(list(x = 1:5)) # define fixed arguments to closing function - -ping_fun <- callable_function(function() TRUE) - -x <- data_connection( # define connection - ping_fun = ping_fun, # define ping function - open_fun = open_fun, # define opening function - close_fun = close_fun # define closing function -) - -x$set_open_args(args = list(y = letters[1:5])) # define additional arguments if necessary - -x$open() # call opening function -x$get_open_call() # check reproducible R code - -# get data from connection via TealDataConnector$get_dataset() -\dontrun{ -x$open(args = list(x = 1:5, y = letters[1:5])) # able to call opening function with arguments -x$close() # call closing function -} - -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealDataConnection-new}{\code{TealDataConnection$new()}} -\item \href{#method-TealDataConnection-finalize}{\code{TealDataConnection$finalize()}} -\item \href{#method-TealDataConnection-is_opened}{\code{TealDataConnection$is_opened()}} -\item \href{#method-TealDataConnection-is_failed}{\code{TealDataConnection$is_failed()}} -\item \href{#method-TealDataConnection-launch}{\code{TealDataConnection$launch()}} -\item \href{#method-TealDataConnection-open}{\code{TealDataConnection$open()}} -\item \href{#method-TealDataConnection-get_conn}{\code{TealDataConnection$get_conn()}} -\item \href{#method-TealDataConnection-get_open_call}{\code{TealDataConnection$get_open_call()}} -\item \href{#method-TealDataConnection-get_open_error_message}{\code{TealDataConnection$get_open_error_message()}} -\item \href{#method-TealDataConnection-get_preopen_server}{\code{TealDataConnection$get_preopen_server()}} -\item \href{#method-TealDataConnection-get_open_server}{\code{TealDataConnection$get_open_server()}} -\item \href{#method-TealDataConnection-get_open_ui}{\code{TealDataConnection$get_open_ui()}} -\item \href{#method-TealDataConnection-is_open_failed}{\code{TealDataConnection$is_open_failed()}} -\item \href{#method-TealDataConnection-set_open_args}{\code{TealDataConnection$set_open_args()}} -\item \href{#method-TealDataConnection-set_preopen_server}{\code{TealDataConnection$set_preopen_server()}} -\item \href{#method-TealDataConnection-set_open_server}{\code{TealDataConnection$set_open_server()}} -\item \href{#method-TealDataConnection-set_open_ui}{\code{TealDataConnection$set_open_ui()}} -\item \href{#method-TealDataConnection-close}{\code{TealDataConnection$close()}} -\item \href{#method-TealDataConnection-get_close_call}{\code{TealDataConnection$get_close_call()}} -\item \href{#method-TealDataConnection-get_close_error_message}{\code{TealDataConnection$get_close_error_message()}} -\item \href{#method-TealDataConnection-get_close_server}{\code{TealDataConnection$get_close_server()}} -\item \href{#method-TealDataConnection-is_close_failed}{\code{TealDataConnection$is_close_failed()}} -\item \href{#method-TealDataConnection-set_close_args}{\code{TealDataConnection$set_close_args()}} -\item \href{#method-TealDataConnection-set_close_ui}{\code{TealDataConnection$set_close_ui()}} -\item \href{#method-TealDataConnection-set_close_server}{\code{TealDataConnection$set_close_server()}} -\item \href{#method-TealDataConnection-clone}{\code{TealDataConnection$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{TealDataConnection} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$new( - open_fun = NULL, - close_fun = NULL, - ping_fun = NULL, - if_conn_obj = FALSE -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{open_fun}}{(\code{CallableFunction}) function to open connection} - -\item{\code{close_fun}}{(\code{CallableFunction}) function to close connection} - -\item{\code{ping_fun}}{(\code{CallableFunction}) function to ping connection} - -\item{\code{if_conn_obj}}{optional, (\code{logical}) whether to store \code{conn} object returned from opening -connection} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -new \code{TealDataConnection} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-finalize}{}}} -\subsection{Method \code{finalize()}}{ -Finalize method closing the connection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$finalize()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -NULL -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-is_opened}{}}} -\subsection{Method \code{is_opened()}}{ -If connection is opened - -If open connection has been successfully evaluated -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$is_opened()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{logical}) if connection is open -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-is_failed}{}}} -\subsection{Method \code{is_failed()}}{ -Check if connection has not failed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$is_failed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{logical}) \code{TRUE} if connection failed, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-launch}{}}} -\subsection{Method \code{launch()}}{ -Run simple application that uses its \code{ui} and \code{server} fields to open the -connection. - -Useful for debugging -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$launch()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -An object that represents the app -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-open}{}}} -\subsection{Method \code{open()}}{ -Open the connection. - -Note that if the connection is already opened then it does nothing. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$open(args = NULL, silent = FALSE, try = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list}) additional arguments not set up previously} - -\item{\code{silent}}{(\code{logical}) whether convert all "missing function" errors to messages} - -\item{\code{try}}{(\code{logical}) whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -returns \code{self} if successful or if connection has been already -opened. If \code{open_fun} fails, app returns an error in form of -\code{shinyjs::alert} (if \code{try = TRUE}) or breaks the app (if \code{try = FALSE}) -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_conn}{}}} -\subsection{Method \code{get_conn()}}{ -Get internal connection object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_conn()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{connection} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_open_call}{}}} -\subsection{Method \code{get_open_call()}}{ -Get executed open connection call -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_open_call(deparse = TRUE, args = NULL, silent = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deparse}}{(\code{logical}) whether return deparsed form of a call} - -\item{\code{args}}{(\code{NULL} or named \code{list}) additional arguments not set up previously} - -\item{\code{silent}}{(\code{logical}) whether convert all "missing function" errors to messages} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -optionally deparsed \code{call} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_open_error_message}{}}} -\subsection{Method \code{get_open_error_message()}}{ -Get error message from last connection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_open_error_message()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{character})\cr -text of the error message or \code{character(0)} if last -connection was successful. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_preopen_server}{}}} -\subsection{Method \code{get_preopen_server()}}{ -Get shiny server module prior opening connection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_preopen_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{function}) shiny server prior opening connection. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_open_server}{}}} -\subsection{Method \code{get_open_server()}}{ -Get shiny server module to open connection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_open_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{function}) shiny server to open connection. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_open_ui}{}}} -\subsection{Method \code{get_open_ui()}}{ -Get Shiny module with inputs to open connection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_open_ui(id)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{\code{character} shiny element id} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{function}) shiny ui to set arguments to open connection function. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-is_open_failed}{}}} -\subsection{Method \code{is_open_failed()}}{ -Check if open connection has not failed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$is_open_failed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{logical}) \code{TRUE} if open connection failed, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_open_args}{}}} -\subsection{Method \code{set_open_args()}}{ -Set open connection function argument -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_open_args(args, silent = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list}) with values where list names are argument names} - -\item{\code{silent}}{(\code{logical}) whether convert all "missing function" errors to messages} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_preopen_server}{}}} -\subsection{Method \code{set_preopen_server()}}{ -Set pre-open connection server function - -This function will be called before submit button will be hit. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_preopen_server(preopen_module)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{preopen_module}}{(\code{function})\cr -A shiny module server function} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_open_server}{}}} -\subsection{Method \code{set_open_server()}}{ -Set open connection server function - -This function will be called after submit button will be hit. There is no possibility to -specify some dynamic \code{ui} as \code{server} function is executed after hitting submit -button. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_open_server(open_module)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{open_module}}{(\code{function})\cr -A shiny module server function that should load data from all connectors} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_open_ui}{}}} -\subsection{Method \code{set_open_ui()}}{ -Set open connection UI function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_open_ui(open_module)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{open_module}}{(\code{function})\cr -shiny module as function. Inputs specified in this \code{ui} are passed to server module -defined by \code{set_open_server} method.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-close}{}}} -\subsection{Method \code{close()}}{ -Close the connection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$close(silent = FALSE, try = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{silent}}{(\code{logical}) whether convert all "missing function" errors to messages} - -\item{\code{try}}{(\code{logical}) whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -returns (\code{self}) if successful. For unsuccessful evaluation it -depends on \code{try} argument: if \code{try = TRUE} then returns -\code{error}, for \code{try = FALSE} otherwise -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_close_call}{}}} -\subsection{Method \code{get_close_call()}}{ -Get executed close connection call -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_close_call(deparse = TRUE, silent = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deparse}}{(\code{logical}) whether return deparsed form of a call} - -\item{\code{silent}}{(\code{logical}) whether convert all "missing function" errors to messages} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -optionally deparsed \code{call} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_close_error_message}{}}} -\subsection{Method \code{get_close_error_message()}}{ -Get error message from last connection -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_close_error_message()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{character})\cr -text of the error message or \code{character(0)} if last -connection was successful. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-get_close_server}{}}} -\subsection{Method \code{get_close_server()}}{ -Get shiny server module to close connection. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$get_close_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -the \verb{server function} to close connection. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-is_close_failed}{}}} -\subsection{Method \code{is_close_failed()}}{ -Check if close connection has not failed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$is_close_failed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{logical}) \code{TRUE} if close connection failed, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_close_args}{}}} -\subsection{Method \code{set_close_args()}}{ -Set close connection function argument -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_close_args(args, silent = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(named \code{list}) with values where list names are argument names} - -\item{\code{silent}}{(\code{logical}) whether convert all "missing function" errors to messages} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_close_ui}{}}} -\subsection{Method \code{set_close_ui()}}{ -Set close connection UI function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_close_ui(close_module)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{close_module}}{(\code{function})\cr -shiny module as function. Inputs specified in this \code{ui} are passed to server module -defined by \code{set_close_server} method.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-set_close_server}{}}} -\subsection{Method \code{set_close_server()}}{ -Set close-connection server function - -This function will be called after submit button will be hit. There is no possibility to -specify some dynamic \code{ui} as \code{server} function is executed after hitting submit -button. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$set_close_server(close_module)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{close_module}}{(\code{function})\cr -A shiny module server function that should load data from all connectors} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnection-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnection$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/TealDataConnector.Rd b/man/TealDataConnector.Rd deleted file mode 100644 index f0cbd40f8..000000000 --- a/man/TealDataConnector.Rd +++ /dev/null @@ -1,436 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataConnector.R -\name{TealDataConnector} -\alias{TealDataConnector} -\title{Manage multiple and \code{TealDatasetConnector} of the same type.} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Class manages \code{TealDatasetConnector} to specify additional dynamic arguments and to -open/close connection. -} -\examples{ - -library(scda) -adsl <- scda_cdisc_dataset_connector(dataname = "ADSL", "adsl") -adlb <- scda_cdisc_dataset_connector(dataname = "ADLB", "adlb") - -open_fun <- callable_function(library) -open_fun$set_args(list(package = "scda")) - -con <- data_connection(open_fun = open_fun) -con$set_open_server( - function(id, connection) { - moduleServer( - id = id, - module = function(input, output, session) { - connection$open(try = TRUE) - return(invisible(connection)) - } - ) - } -) - -x <- teal.data:::TealDataConnector$new(connection = con, connectors = list(adsl, adlb)) - -x$set_ui( - function(id, connection, connectors) { - ns <- NS(id) - tagList( - connection$get_open_ui(ns("open_connection")), - textInput(ns("name"), p("Choose", code("scda data version")), value = "latest"), - do.call( - what = "tagList", - args = lapply( - connectors, - function(connector) { - div( - connector$get_ui( - id = ns(connector$get_dataname()) - ), - br() - ) - } - ) - ) - ) - } -) - -x$set_server( - function(id, connection, connectors) { - moduleServer( - id = id, - module = function(input, output, session) { - # opens connection - connection$get_open_server()(id = "open_connection", connection = connection) - if (connection$is_opened()) { - for (connector in connectors) { - set_args(connector, args = list(archive_name = input$name)) - # pull each dataset - connector$get_server()(id = connector$get_dataname()) - if (connector$is_failed()) { - break - } - } - } - } - ) - } -) -\dontrun{ -x$launch() -x$get_datasets() -} -} -\section{Super class}{ -\code{\link[teal.data:TealDataAbstract]{teal.data::TealDataAbstract}} -> \code{TealDataConnector} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealDataConnector-new}{\code{TealDataConnector$new()}} -\item \href{#method-TealDataConnector-print}{\code{TealDataConnector$print()}} -\item \href{#method-TealDataConnector-get_connection}{\code{TealDataConnector$get_connection()}} -\item \href{#method-TealDataConnector-get_code_class}{\code{TealDataConnector$get_code_class()}} -\item \href{#method-TealDataConnector-get_server}{\code{TealDataConnector$get_server()}} -\item \href{#method-TealDataConnector-get_preopen_server}{\code{TealDataConnector$get_preopen_server()}} -\item \href{#method-TealDataConnector-get_ui}{\code{TealDataConnector$get_ui()}} -\item \href{#method-TealDataConnector-set_pull_args}{\code{TealDataConnector$set_pull_args()}} -\item \href{#method-TealDataConnector-set_ui}{\code{TealDataConnector$set_ui()}} -\item \href{#method-TealDataConnector-set_server}{\code{TealDataConnector$set_server()}} -\item \href{#method-TealDataConnector-set_preopen_server}{\code{TealDataConnector$set_preopen_server()}} -\item \href{#method-TealDataConnector-pull}{\code{TealDataConnector$pull()}} -\item \href{#method-TealDataConnector-launch}{\code{TealDataConnector$launch()}} -\item \href{#method-TealDataConnector-mutate}{\code{TealDataConnector$mutate()}} -\item \href{#method-TealDataConnector-is_failed}{\code{TealDataConnector$is_failed()}} -\item \href{#method-TealDataConnector-clone}{\code{TealDataConnector$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{TealDataConnector} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$new(connection, connectors)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{connection}}{(\code{TealDataConnection})\cr -connection to data source} - -\item{\code{connectors}}{(\code{list} of \code{TealDatasetConnector} elements)\cr -list with dataset connectors} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-print}{}}} -\subsection{Method \code{print()}}{ -Prints this \code{TealDataConnector}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$print(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{additional arguments to the printing method} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -invisibly self -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-get_connection}{}}} -\subsection{Method \code{get_connection()}}{ -Get connection to data source -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$get_connection()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -connector's connection -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-get_code_class}{}}} -\subsection{Method \code{get_code_class()}}{ -Get internal \code{CodeClass} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$get_code_class()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{CodeClass} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-get_server}{}}} -\subsection{Method \code{get_server()}}{ -get the server function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$get_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -the \code{server} function -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-get_preopen_server}{}}} -\subsection{Method \code{get_preopen_server()}}{ -get the \code{preopen} server function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$get_preopen_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -the \code{server} function -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-get_ui}{}}} -\subsection{Method \code{get_ui()}}{ -Get Shiny module with inputs for all \code{TealDatasetConnector} objects -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$get_ui(id)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{\code{character} shiny element id} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -the \code{ui} function -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-set_pull_args}{}}} -\subsection{Method \code{set_pull_args()}}{ -Set argument to the \code{pull_fun} -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$set_pull_args(args)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(named \code{list})\cr -arguments values as separate list elements named by argument name. These arguments -are passed to each dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -nothing -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-set_ui}{}}} -\subsection{Method \code{set_ui()}}{ -Set connector UI function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$set_ui(f)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{f}}{(\code{function})\cr -shiny module as function. Inputs specified in this \code{ui} are passed to server module -defined by \code{set_server} method.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -nothing -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-set_server}{}}} -\subsection{Method \code{set_server()}}{ -Set connector server function - -This function will be called after submit button will be hit. There is no possibility to -specify some dynamic \code{ui} as \code{server} function is executed after hitting submit -button. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$set_server(f)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{f}}{(\code{function})\cr -A shiny module server function that should load data from all connectors} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -nothing -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-set_preopen_server}{}}} -\subsection{Method \code{set_preopen_server()}}{ -Set connector pre-open server function - -This function will be called before submit button will be hit. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$set_preopen_server(f)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{f}}{(\code{function})\cr -A shiny module server function} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -nothing -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-pull}{}}} -\subsection{Method \code{pull()}}{ -Load data from each \code{TealDatasetConnector} -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$pull(con_args = NULL, args = NULL, try = TRUE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{con_args}}{(\code{NULL} or named \code{list})\cr -additional dynamic arguments for connection function. \code{args} will be passed to each -\code{TealDatasetConnector} object to evaluate \code{CallableFunction} assigned to -this dataset. If \code{args} is null than default set of arguments will be used, otherwise -call will be executed on these arguments only (arguments set before will be ignored). -\code{pull} function doesn't update reproducible call, it's just evaluate function.} - -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -additional dynamic arguments to pull dataset. \code{args} will be passed to each -\code{TealDatasetConnector} object to evaluate \code{CallableFunction} assigned to -this dataset. If \code{args} is null than default set of arguments will be used, otherwise -call will be executed on these arguments only (arguments set before will be ignored). -\code{pull} function doesn't update reproducible call, it's just evaluate function.} - -\item{\code{try}}{(\code{logical} value)\cr -whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. In order to get the data please use \code{get_datasets} method. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-launch}{}}} -\subsection{Method \code{launch()}}{ -Run simple application that uses its \code{ui} and \code{server} fields to pull data from -connection. - -Useful for debugging -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$launch()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -An object that represents the app -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-mutate}{}}} -\subsection{Method \code{mutate()}}{ -Mutate data by code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$mutate(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{parameters inherited from \code{TealDataAbstract}.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -Informational message to not use mutate_data() with \code{TealDataConnectors}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-is_failed}{}}} -\subsection{Method \code{is_failed()}}{ -Check if pull or connection has not failed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$is_failed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if pull or connection failed, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataConnector-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataConnector$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/TealDataset.Rd b/man/TealDataset.Rd deleted file mode 100644 index da61d22fa..000000000 --- a/man/TealDataset.Rd +++ /dev/null @@ -1,764 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataset.R -\name{TealDataset} -\alias{TealDataset} -\title{R6 Class representing a dataset with its attributes} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Any \code{data.frame} object can be stored inside this object. -Some attributes like colnames, dimension or column names for a specific type will -be automatically derived. -} -\examples{ - -## ------------------------------------------------ -## Method `TealDataset$reassign_datasets_vars` -## ------------------------------------------------ - -test_dataset <- teal.data:::TealDataset$new( - dataname = "iris", - x = iris, - vars = list(dep = teal.data:::TealDataset$new("iris2", iris)) -) -test_dataset$reassign_datasets_vars( - list(iris2 = teal.data:::TealDataset$new("iris2", head(iris))) -) - -} -\seealso{ -\code{\link{MAETealDataset}} -} -\section{Active bindings}{ -\if{html}{\out{
}} -\describe{ -\item{\code{raw_data}}{The data.frame behind this R6 class} - -\item{\code{data}}{The data.frame behind this R6 class} - -\item{\code{var_names}}{The column names of the data} -} -\if{html}{\out{
}} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealDataset-new}{\code{TealDataset$new()}} -\item \href{#method-TealDataset-recreate}{\code{TealDataset$recreate()}} -\item \href{#method-TealDataset-print}{\code{TealDataset$print()}} -\item \href{#method-TealDataset-get_dataset}{\code{TealDataset$get_dataset()}} -\item \href{#method-TealDataset-get_attrs}{\code{TealDataset$get_attrs()}} -\item \href{#method-TealDataset-get_raw_data}{\code{TealDataset$get_raw_data()}} -\item \href{#method-TealDataset-get_numeric_colnames}{\code{TealDataset$get_numeric_colnames()}} -\item \href{#method-TealDataset-get_character_colnames}{\code{TealDataset$get_character_colnames()}} -\item \href{#method-TealDataset-get_factor_colnames}{\code{TealDataset$get_factor_colnames()}} -\item \href{#method-TealDataset-get_colnames}{\code{TealDataset$get_colnames()}} -\item \href{#method-TealDataset-get_column_labels}{\code{TealDataset$get_column_labels()}} -\item \href{#method-TealDataset-get_ncol}{\code{TealDataset$get_ncol()}} -\item \href{#method-TealDataset-get_nrow}{\code{TealDataset$get_nrow()}} -\item \href{#method-TealDataset-get_rownames}{\code{TealDataset$get_rownames()}} -\item \href{#method-TealDataset-get_row_labels}{\code{TealDataset$get_row_labels()}} -\item \href{#method-TealDataset-get_dataname}{\code{TealDataset$get_dataname()}} -\item \href{#method-TealDataset-get_datanames}{\code{TealDataset$get_datanames()}} -\item \href{#method-TealDataset-get_dataset_label}{\code{TealDataset$get_dataset_label()}} -\item \href{#method-TealDataset-get_keys}{\code{TealDataset$get_keys()}} -\item \href{#method-TealDataset-get_metadata}{\code{TealDataset$get_metadata()}} -\item \href{#method-TealDataset-get_var_r6}{\code{TealDataset$get_var_r6()}} -\item \href{#method-TealDataset-reassign_datasets_vars}{\code{TealDataset$reassign_datasets_vars()}} -\item \href{#method-TealDataset-set_dataset_label}{\code{TealDataset$set_dataset_label()}} -\item \href{#method-TealDataset-set_keys}{\code{TealDataset$set_keys()}} -\item \href{#method-TealDataset-set_vars}{\code{TealDataset$set_vars()}} -\item \href{#method-TealDataset-set_code}{\code{TealDataset$set_code()}} -\item \href{#method-TealDataset-get_code}{\code{TealDataset$get_code()}} -\item \href{#method-TealDataset-get_code_class}{\code{TealDataset$get_code_class()}} -\item \href{#method-TealDataset-get_mutate_code_class}{\code{TealDataset$get_mutate_code_class()}} -\item \href{#method-TealDataset-get_vars}{\code{TealDataset$get_vars()}} -\item \href{#method-TealDataset-get_mutate_vars}{\code{TealDataset$get_mutate_vars()}} -\item \href{#method-TealDataset-is_mutate_delayed}{\code{TealDataset$is_mutate_delayed()}} -\item \href{#method-TealDataset-mutate}{\code{TealDataset$mutate()}} -\item \href{#method-TealDataset-check}{\code{TealDataset$check()}} -\item \href{#method-TealDataset-check_keys}{\code{TealDataset$check_keys()}} -\item \href{#method-TealDataset-is_pulled}{\code{TealDataset$is_pulled()}} -\item \href{#method-TealDataset-clone}{\code{TealDataset$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-new}{}}} -\subsection{Method \code{new()}}{ -Create a new object of \code{TealDataset} class -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$new( - dataname, - x, - keys = character(0), - code = character(0), - label = character(0), - vars = list(), - metadata = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{x}}{(\code{data.frame})\cr} - -\item{\code{keys}}{optional, (\code{character})\cr -Vector with primary keys} - -\item{\code{code}}{(\code{character})\cr -A character string defining the code needed to produce the data set in \code{x}. -\code{initialize()} and \code{recreate()} accept code as \code{CodeClass} -which is also needed to preserve the code uniqueness and correct order.} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It is recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list} or \code{NULL}) \cr -Field containing metadata about the dataset. Each element of the list -should be atomic and of length one.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-recreate}{}}} -\subsection{Method \code{recreate()}}{ -Recreate this \code{TealDataset} with its current attributes. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$recreate( - dataname = self$get_dataname(), - x = self$get_raw_data(), - keys = self$get_keys(), - code = private$code, - label = self$get_dataset_label(), - vars = list(), - metadata = self$get_metadata() -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{x}}{(\code{data.frame})\cr} - -\item{\code{keys}}{optional, (\code{character})\cr -Vector with primary keys} - -\item{\code{code}}{(\code{character})\cr -A character string defining the code needed to produce the data set in \code{x}. -\code{initialize()} and \code{recreate()} accept code as \code{CodeClass} -which is also needed to preserve the code uniqueness and correct order.} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It is recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list} or \code{NULL}) \cr -Field containing metadata about the dataset. Each element of the list -should be atomic and of length one.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -a new object of the \code{TealDataset} class -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-print}{}}} -\subsection{Method \code{print()}}{ -Prints this \code{TealDataset}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$print(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{additional arguments to the printing method} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -invisibly self -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_dataset}{}}} -\subsection{Method \code{get_dataset()}}{ -Performs any delayed mutate calls before returning self. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_dataset()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -dataset (\code{TealDataset}) -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_attrs}{}}} -\subsection{Method \code{get_attrs()}}{ -Get all dataset attributes -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_attrs()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(named \code{list}) with dataset attributes -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_raw_data}{}}} -\subsection{Method \code{get_raw_data()}}{ -Derive the raw data frame inside this object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_raw_data()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{data.frame} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_numeric_colnames}{}}} -\subsection{Method \code{get_numeric_colnames()}}{ -Derive the names of all \code{numeric} columns -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_numeric_colnames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_character_colnames}{}}} -\subsection{Method \code{get_character_colnames()}}{ -Derive the names of all \code{character} columns -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_character_colnames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_factor_colnames}{}}} -\subsection{Method \code{get_factor_colnames()}}{ -Derive the names of all \code{factor} columns -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_factor_colnames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_colnames}{}}} -\subsection{Method \code{get_colnames()}}{ -Derive the column names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_colnames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_column_labels}{}}} -\subsection{Method \code{get_column_labels()}}{ -Derive the column labels -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_column_labels()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_ncol}{}}} -\subsection{Method \code{get_ncol()}}{ -Get the number of columns of the data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_ncol()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{numeric} vector -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_nrow}{}}} -\subsection{Method \code{get_nrow()}}{ -Get the number of rows of the data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_nrow()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{numeric} vector -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_rownames}{}}} -\subsection{Method \code{get_rownames()}}{ -Derive the row names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_rownames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_row_labels}{}}} -\subsection{Method \code{get_row_labels()}}{ -Derive the row labels -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_row_labels()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_dataname}{}}} -\subsection{Method \code{get_dataname()}}{ -Derive the \code{name} which was formerly called \code{dataname} -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_dataname()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} name of the dataset -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_datanames}{}}} -\subsection{Method \code{get_datanames()}}{ -Derive the dataname -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_datanames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} name of the dataset -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_dataset_label}{}}} -\subsection{Method \code{get_dataset_label()}}{ -Derive the \code{label} which was former called \code{datalabel} -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_dataset_label()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} label of the dataset -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_keys}{}}} -\subsection{Method \code{get_keys()}}{ -Get primary keys of dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_keys()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(\code{character} vector) with dataset primary keys -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_metadata}{}}} -\subsection{Method \code{get_metadata()}}{ -Get metadata of dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_metadata()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -(named \code{list}) -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_var_r6}{}}} -\subsection{Method \code{get_var_r6()}}{ -Get the list of dependencies that are \code{TealDataset} or \code{TealDatasetConnector} objects -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_var_r6()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{list} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-reassign_datasets_vars}{}}} -\subsection{Method \code{reassign_datasets_vars()}}{ -Overwrites \code{TealDataset} or \code{TealDatasetConnector} dependencies of this \code{TealDataset} with -those found in \code{datasets}. Reassignment -refers only to the provided \code{datasets}, other \code{vars} remains the same. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$reassign_datasets_vars(datasets)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{datasets}}{(\verb{named list} of \code{TealDataset(s)} or \code{TealDatasetConnector(s)})\cr -objects with valid pointers.} -} -\if{html}{\out{
}} -} -\subsection{Details}{ -Reassign \code{vars} in this object to keep references up to date after deep clone. -Update is done based on the objects passed in \code{datasets} argument. -Overwrites dependencies with names matching the names of the objects passed -in \code{datasets}. -} - -\subsection{Returns}{ -NULL invisible -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{test_dataset <- teal.data:::TealDataset$new( - dataname = "iris", - x = iris, - vars = list(dep = teal.data:::TealDataset$new("iris2", iris)) -) -test_dataset$reassign_datasets_vars( - list(iris2 = teal.data:::TealDataset$new("iris2", head(iris))) -) - -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-set_dataset_label}{}}} -\subsection{Method \code{set_dataset_label()}}{ -Set the label for the dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$set_dataset_label(label)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-set_keys}{}}} -\subsection{Method \code{set_keys()}}{ -Set new keys -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$set_keys(keys)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{keys}}{optional, (\code{character})\cr -Vector with primary keys} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-set_vars}{}}} -\subsection{Method \code{set_vars()}}{ -Adds variables which code depends on -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$set_vars(vars)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{vars}}{(\verb{named list}) contains any R object which code depends on} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-set_code}{}}} -\subsection{Method \code{set_code()}}{ -Sets reproducible code -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$set_code(code)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{(\code{character})\cr -A character string defining the code needed to produce the data set in \code{x}. -\code{initialize()} and \code{recreate()} accept code as \code{CodeClass} -which is also needed to preserve the code uniqueness and correct order.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_code}{}}} -\subsection{Method \code{get_code()}}{ -Get code to get data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_code(deparse = TRUE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deparse}}{(\code{logical}) whether return deparsed form of a call} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -optionally deparsed \code{call} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_code_class}{}}} -\subsection{Method \code{get_code_class()}}{ -Get internal \code{CodeClass} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_code_class(nodeps = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{nodeps}}{(\code{logical(1)}) whether \code{CodeClass} should not contain the code -of the dependent \code{vars} -the \code{mutate}} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{CodeClass} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_mutate_code_class}{}}} -\subsection{Method \code{get_mutate_code_class()}}{ -Get internal \code{CodeClass} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_mutate_code_class()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{CodeClass} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_vars}{}}} -\subsection{Method \code{get_vars()}}{ -Get internal \code{vars} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_vars()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{list} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_mutate_vars}{}}} -\subsection{Method \code{get_mutate_vars()}}{ -Get internal \code{mutate_vars} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$get_mutate_vars()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{list} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-is_mutate_delayed}{}}} -\subsection{Method \code{is_mutate_delayed()}}{ -Whether mutate code has delayed evaluation. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$is_mutate_delayed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{logical} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-mutate}{}}} -\subsection{Method \code{mutate()}}{ -Mutate dataset by code -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$mutate(code, vars = list(), force_delay = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{(\code{CodeClass}) or (\code{character}) R expressions to be executed} - -\item{\code{vars}}{a named list of R objects that \code{code} depends on to execute} - -\item{\code{force_delay}}{(\code{logical}) used by the containing \code{TealDatasetConnector} object - -Either code or script must be provided, but not both.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-check}{}}} -\subsection{Method \code{check()}}{ -Check to determine if the raw data is reproducible from the \code{get_code()} code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$check()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if the dataset generated from evaluating the -\code{get_code()} code is identical to the raw data, else \code{FALSE}. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-check_keys}{}}} -\subsection{Method \code{check_keys()}}{ -Check if keys has been specified correctly for dataset. Set of \code{keys} -should distinguish unique rows or be \code{character(0)}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$check_keys(keys = private$.keys)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{keys}}{optional, (\code{character})\cr -Vector with primary keys} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -\code{TRUE} if dataset has been already pulled, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-is_pulled}{}}} -\subsection{Method \code{is_pulled()}}{ -Check if dataset has already been pulled. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$is_pulled()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if dataset has been already pulled, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDataset$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/TealDatasetConnector.Rd b/man/TealDatasetConnector.Rd deleted file mode 100644 index d3b0f473a..000000000 --- a/man/TealDatasetConnector.Rd +++ /dev/null @@ -1,651 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector.R -\name{TealDatasetConnector} -\alias{TealDatasetConnector} -\title{A \code{TealDatasetConnector} class of objects} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Objects of this class store the connection function to fetch a single dataset. -Note that for some specific connection types, -an object of class \code{TealDataConnection} must be provided. -Data can be pulled via the \code{pull} method and accessed directly -through the \code{dataset} active binding. -Pulled data inherits from the class \code{\link{TealDataset}} -} -\examples{ - -## ------------------------------------------------ -## Method `TealDatasetConnector$set_ui_input` -## ------------------------------------------------ - -ds <- dataset_connector("xyz", pull_callable = callable_function(data.frame)) -ds$set_ui_input( - function(ns) { - list(sliderInput(ns("colA"), "Select value for colA", min = 0, max = 10, value = 3), - sliderInput(ns("colB"), "Select value for colB", min = 0, max = 10, value = 7)) - } -) -\dontrun{ -ds$launch() -} - -## ------------------------------------------------ -## Method `TealDatasetConnector$launch` -## ------------------------------------------------ - -ds <- dataset_connector("xyz", pull_callable = callable_function(data.frame)) -ds$set_ui_input( - function(ns) { - list(sliderInput(ns("colA"), "Select value for colA", min = 0, max = 10, value = 3), - sliderInput(ns("colB"), "Select value for colB", min = 0, max = 10, value = 7)) - } -) -\dontrun{ -ds$launch() -} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-TealDatasetConnector-new}{\code{TealDatasetConnector$new()}} -\item \href{#method-TealDatasetConnector-print}{\code{TealDatasetConnector$print()}} -\item \href{#method-TealDatasetConnector-get_dataname}{\code{TealDatasetConnector$get_dataname()}} -\item \href{#method-TealDatasetConnector-get_datanames}{\code{TealDatasetConnector$get_datanames()}} -\item \href{#method-TealDatasetConnector-get_dataset_label}{\code{TealDatasetConnector$get_dataset_label()}} -\item \href{#method-TealDatasetConnector-get_keys}{\code{TealDatasetConnector$get_keys()}} -\item \href{#method-TealDatasetConnector-get_code}{\code{TealDatasetConnector$get_code()}} -\item \href{#method-TealDatasetConnector-get_code_class}{\code{TealDatasetConnector$get_code_class()}} -\item \href{#method-TealDatasetConnector-get_pull_args}{\code{TealDatasetConnector$get_pull_args()}} -\item \href{#method-TealDatasetConnector-get_dataset}{\code{TealDatasetConnector$get_dataset()}} -\item \href{#method-TealDatasetConnector-get_error_message}{\code{TealDatasetConnector$get_error_message()}} -\item \href{#method-TealDatasetConnector-get_pull_callable}{\code{TealDatasetConnector$get_pull_callable()}} -\item \href{#method-TealDatasetConnector-get_raw_data}{\code{TealDatasetConnector$get_raw_data()}} -\item \href{#method-TealDatasetConnector-get_var_r6}{\code{TealDatasetConnector$get_var_r6()}} -\item \href{#method-TealDatasetConnector-reassign_datasets_vars}{\code{TealDatasetConnector$reassign_datasets_vars()}} -\item \href{#method-TealDatasetConnector-set_dataset_label}{\code{TealDatasetConnector$set_dataset_label()}} -\item \href{#method-TealDatasetConnector-set_keys}{\code{TealDatasetConnector$set_keys()}} -\item \href{#method-TealDatasetConnector-pull}{\code{TealDatasetConnector$pull()}} -\item \href{#method-TealDatasetConnector-set_args}{\code{TealDatasetConnector$set_args()}} -\item \href{#method-TealDatasetConnector-mutate}{\code{TealDatasetConnector$mutate()}} -\item \href{#method-TealDatasetConnector-is_failed}{\code{TealDatasetConnector$is_failed()}} -\item \href{#method-TealDatasetConnector-is_pulled}{\code{TealDatasetConnector$is_pulled()}} -\item \href{#method-TealDatasetConnector-is_mutate_delayed}{\code{TealDatasetConnector$is_mutate_delayed()}} -\item \href{#method-TealDatasetConnector-check}{\code{TealDatasetConnector$check()}} -\item \href{#method-TealDatasetConnector-set_ui_input}{\code{TealDatasetConnector$set_ui_input()}} -\item \href{#method-TealDatasetConnector-get_ui}{\code{TealDatasetConnector$get_ui()}} -\item \href{#method-TealDatasetConnector-get_server}{\code{TealDatasetConnector$get_server()}} -\item \href{#method-TealDatasetConnector-launch}{\code{TealDatasetConnector$launch()}} -\item \href{#method-TealDatasetConnector-clone}{\code{TealDatasetConnector$clone()}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-new}{}}} -\subsection{Method \code{new()}}{ -Create a new \code{TealDatasetConnector} object. Set the pulling function -\code{CallableFunction} which returns a \code{data.frame} or \code{MultiAssayExperiment}, -e.g. by reading from a function or creating it on the fly. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$new( - dataname, - pull_callable, - keys = character(0), - label = character(0), - code = character(0), - vars = list(), - metadata = NULL -)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{dataname}}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{\code{pull_callable}}{(\code{CallableFunction})\cr -function with necessary arguments set to fetch data from connection.} - -\item{\code{keys}}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset.} - -\item{\code{code}}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{\code{metadata}}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-print}{}}} -\subsection{Method \code{print()}}{ -Prints this \code{TealDatasetConnector}. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$print(...)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{additional arguments to the printing method} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -invisibly self -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_dataname}{}}} -\subsection{Method \code{get_dataname()}}{ -Get dataname of dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_dataname()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -dataname of the dataset -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_datanames}{}}} -\subsection{Method \code{get_datanames()}}{ -Get dataname of dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_datanames()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} dataname of the dataset -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_dataset_label}{}}} -\subsection{Method \code{get_dataset_label()}}{ -Get label of dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_dataset_label()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} dataset label -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_keys}{}}} -\subsection{Method \code{get_keys()}}{ -Get primary keys of dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_keys()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} vector with dataset primary keys -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_code}{}}} -\subsection{Method \code{get_code()}}{ -Get code to get data -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_code(deparse = TRUE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deparse}}{(\code{logical})\cr -whether return deparsed form of a call} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -optionally deparsed \code{call} object -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_code_class}{}}} -\subsection{Method \code{get_code_class()}}{ -Get internal \code{CodeClass} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_code_class()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{CodeClass} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_pull_args}{}}} -\subsection{Method \code{get_pull_args()}}{ -Derive the arguments this connector will pull with -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_pull_args()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{list} of pull function fixed arguments -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_dataset}{}}} -\subsection{Method \code{get_dataset()}}{ -Get dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_dataset()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -dataset (\code{TealDataset}) -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_error_message}{}}} -\subsection{Method \code{get_error_message()}}{ -Get error message from last pull -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_error_message()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{character} object with error message or \code{character(0)} if last -pull was successful. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_pull_callable}{}}} -\subsection{Method \code{get_pull_callable()}}{ -Get pull function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_pull_callable()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{CallableFunction} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_raw_data}{}}} -\subsection{Method \code{get_raw_data()}}{ -Get raw data from dataset -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_raw_data()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{data.frame} or \code{MultiAssayExperiment} data -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_var_r6}{}}} -\subsection{Method \code{get_var_r6()}}{ -Get the list of dependencies that are \code{TealDataset} or \code{TealDatasetConnector} objects -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_var_r6()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{list} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-reassign_datasets_vars}{}}} -\subsection{Method \code{reassign_datasets_vars()}}{ -Reassign \code{vars} in this object to keep references up to date after deep clone. -Update is done based on the objects passed in \code{datasets} argument. Reassignment -refers only to the provided \code{datasets}, other \code{vars} remains the same. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$reassign_datasets_vars(datasets)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{datasets}}{(\verb{named list} of \code{TealDataset(s)} or \code{TealDatasetConnector(s)})\cr -objects with valid pointers.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -NULL invisible -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-set_dataset_label}{}}} -\subsection{Method \code{set_dataset_label()}}{ -Set label of the \code{dataset} object -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$set_dataset_label(label)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{label}}{(\code{character})\cr -Label to describe the dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-set_keys}{}}} -\subsection{Method \code{set_keys()}}{ -Set new keys -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$set_keys(keys)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{keys}}{optional, (\code{character})\cr -vector of dataset primary keys column names} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-pull}{}}} -\subsection{Method \code{pull()}}{ -Pull the data (and metadata if it is a \code{Callable}) - -Read or create data using \code{pull_callable} specified in the constructor. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$pull(args = NULL, try = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list})\cr -additional dynamic arguments for pull function. \code{args} can be omitted if \code{pull_callable} -from constructor already contains all necessary arguments to pull data. One can try -to execute \code{pull_callable} directly by \code{x$pull_callable$run()} or to get code using -\code{x$pull_callable$get_code()}. \code{args} specified in pull are used temporary to get data but -not saved in code.} - -\item{\code{try}}{(\code{logical} value)\cr -whether perform function evaluation inside \code{try} clause} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) if successful. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-set_args}{}}} -\subsection{Method \code{set_args()}}{ -Set arguments to the pulling function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$set_args(args)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{args}}{(\code{NULL} or named \code{list}) dynamic arguments to function} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-mutate}{}}} -\subsection{Method \code{mutate()}}{ -Dispatcher for either eager or delayed mutate methods - -Either code or script must be provided, but not both. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$mutate(code, vars = list())}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{code}}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{\code{vars}}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-is_failed}{}}} -\subsection{Method \code{is_failed()}}{ -Check if pull has not failed. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$is_failed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if pull failed, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-is_pulled}{}}} -\subsection{Method \code{is_pulled()}}{ -Check if dataset has already been pulled. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$is_pulled()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} if connector has been already pulled, else \code{FALSE} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-is_mutate_delayed}{}}} -\subsection{Method \code{is_mutate_delayed()}}{ -Check if dataset has mutations that are delayed -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$is_mutate_delayed()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{logical} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-check}{}}} -\subsection{Method \code{check()}}{ -Check to determine if the raw data is reproducible from the -\code{get_code()} code. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$check()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -\code{TRUE} always for all connectors to avoid evaluating the same code multiple times. -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-set_ui_input}{}}} -\subsection{Method \code{set_ui_input()}}{ -Sets the shiny UI according to the given inputs. -Inputs must provide only scalar (length of 1) variables. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$set_ui_input(inputs = NULL)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{inputs}}{(\code{function}) A shiny module UI function with single argument \code{ns}. -This function needs to return a list of shiny inputs with their \code{inputId} wrapped -in function \code{ns}. The \code{inputId} must match exactly the argument name to be set. -See example. -Nested lists are not allowed.} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining. -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{ds <- dataset_connector("xyz", pull_callable = callable_function(data.frame)) -ds$set_ui_input( - function(ns) { - list(sliderInput(ns("colA"), "Select value for colA", min = 0, max = 10, value = 3), - sliderInput(ns("colB"), "Select value for colB", min = 0, max = 10, value = 7)) - } -) -\dontrun{ -ds$launch() -} -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_ui}{}}} -\subsection{Method \code{get_ui()}}{ -Get shiny ui function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_ui(id)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{id}}{(\code{character}) namespace id} -} -\if{html}{\out{
}} -} -\subsection{Returns}{ -shiny UI in given namespace id -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_server}{}}} -\subsection{Method \code{get_server()}}{ -Get shiny server function -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$get_server()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -shiny server function -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-launch}{}}} -\subsection{Method \code{launch()}}{ -Launches a shiny app. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$launch()}\if{html}{\out{
}} -} - -\subsection{Returns}{ -Shiny app -} -\subsection{Examples}{ -\if{html}{\out{
}} -\preformatted{ds <- dataset_connector("xyz", pull_callable = callable_function(data.frame)) -ds$set_ui_input( - function(ns) { - list(sliderInput(ns("colA"), "Select value for colA", min = 0, max = 10, value = 3), - sliderInput(ns("colB"), "Select value for colB", min = 0, max = 10, value = 7)) - } -) -\dontrun{ -ds$launch() -} -} -\if{html}{\out{
}} - -} - -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{TealDatasetConnector$clone(deep = FALSE)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{deep}}{Whether to make a deep clone.} -} -\if{html}{\out{
}} -} -} -} diff --git a/man/as_cdisc.Rd b/man/as_cdisc.Rd deleted file mode 100644 index 03d372c91..000000000 --- a/man/as_cdisc.Rd +++ /dev/null @@ -1,91 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/as_cdisc.R -\name{as_cdisc} -\alias{as_cdisc} -\alias{as_cdisc.TealDataset} -\alias{as_cdisc.TealDatasetConnector} -\title{Convert a \code{TealDataset(Connector)} object to a \code{CDISCTealDataset(Connector)} object} -\usage{ -as_cdisc( - x, - parent = if (identical(get_dataname(x), "ADSL")) character(0) else "ADSL" -) - -\method{as_cdisc}{TealDataset}( - x, - parent = if (identical(get_dataname(x), "ADSL")) character(0) else "ADSL" -) - -\method{as_cdisc}{TealDatasetConnector}( - x, - parent = if (identical(get_dataname(x), "ADSL")) character(0) else "ADSL" -) -} -\arguments{ -\item{x}{an object of \code{TealDataset} or \code{TealDatasetConnector} class} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\value{ -(\code{CDISCTealDataset} or \code{CDISCTealDatasetConnector}) object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Convert a \code{TealDataset(Connector)} object to a \code{CDISCTealDataset(Connector)} object -} -\note{ -If passed a \code{CDISC}-flavored object it returns the unmodified object. -} -\examples{ -# TealDataset -------- - -library(scda) -as_cdisc( - dataset( - "ADSL", - synthetic_cdisc_data("latest")$adsl, - keys = get_cdisc_keys("ADSL"), - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" - ) -) -as_cdisc( - dataset( - "ADAE", - synthetic_cdisc_data("latest")$adae, - keys = get_cdisc_keys("ADAE"), - code = "ADAE <- synthetic_cdisc_data(\"latest\")$adae" - ), - parent = "ADSL" -) -# TealDatasetConnector -------- - -library(scda) -pull_fun_adsl <- callable_function( - function() { - synthetic_cdisc_data("latest")$adsl - } -) -as_cdisc( - dataset_connector( - "ADSL", - pull_fun_adsl, - keys = get_cdisc_keys("ADSL") - ) -) - -pull_fun_adae <- callable_function( - function() { - synthetic_cdisc_data("latest")$adae - } -) -as_cdisc( - dataset_connector( - "ADAE", - pull_fun_adae, - keys = get_cdisc_keys("ADAE") - ), - parent = "ADSL" -) -} diff --git a/man/callable_code.Rd b/man/callable_code.Rd deleted file mode 100644 index 32ae714e3..000000000 --- a/man/callable_code.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallableCode.R -\name{callable_code} -\alias{callable_code} -\title{Create \code{\link{CallableCode}} object} -\usage{ -callable_code(code) -} -\arguments{ -\item{code}{(\code{character})\cr -a string containing R code to reproduce the desired object. Please be aware -that objects assigned to temporary environment are locked which means -that they can't be modified.} -} -\value{ -\code{CallableCode} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -Create \link{CallableCode} object to execute specific code and get reproducible call. -} -\examples{ -cf <- callable_code(code = "mtcars") -cf$run() -cf$get_call() -} diff --git a/man/callable_function.Rd b/man/callable_function.Rd deleted file mode 100644 index 70c9e4cf5..000000000 --- a/man/callable_function.Rd +++ /dev/null @@ -1,26 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallableFunction.R -\name{callable_function} -\alias{callable_function} -\title{Create \code{CallableFunction} object} -\usage{ -callable_function(fun) -} -\arguments{ -\item{fun}{(\code{function})\cr -any R function, directly by name or \code{character} string.} -} -\value{ -\code{CallableFunction} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Create \code{\link{CallableFunction}} object to execute specific function and get reproducible -call. -} -\examples{ -cf <- callable_function(fun = stats::median) -cf$set_args(list(x = 1:10, na.rm = FALSE)) -cf$run() -cf$get_call() -} diff --git a/man/cdisc_data.Rd b/man/cdisc_data.Rd index 38839fd86..fd8338e5e 100644 --- a/man/cdisc_data.Rd +++ b/man/cdisc_data.Rd @@ -4,7 +4,12 @@ \alias{cdisc_data} \title{Data input for teal app} \usage{ -cdisc_data(..., join_keys = teal.data::join_keys(), code = "", check = FALSE) +cdisc_data( + ..., + join_keys = default_cdisc_join_keys(names(list(...))), + code = "", + check = FALSE +) } \arguments{ \item{...}{(\code{TealDataConnector}, \code{TealDataset} or diff --git a/man/cdisc_data_connector.Rd b/man/cdisc_data_connector.Rd deleted file mode 100644 index c5f4ddf20..000000000 --- a/man/cdisc_data_connector.Rd +++ /dev/null @@ -1,41 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealDataConnector.R -\name{cdisc_data_connector} -\alias{cdisc_data_connector} -\title{The constructor of \code{CDISCTealDataConnector} objects.} -\usage{ -cdisc_data_connector(connection, connectors) -} -\arguments{ -\item{connection}{(\code{TealDataConnection})\cr -connection to data source} - -\item{connectors}{(\code{list} of \code{TealDatasetConnector} elements)\cr -list with dataset connectors} -} -\value{ -\code{CDISCTealDataConnector} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -adsl_cf <- callable_function( - function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) -) -adae_cf <- callable_function( - function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE")))) -) -adsl <- cdisc_dataset_connector( - "ADSL", adsl_cf, - keys = get_cdisc_keys("ADSL"), parent = character(0) -) -adae <- cdisc_dataset_connector( - "ADAE", adae_cf, - keys = get_cdisc_keys("ADAE"), parent = "ADSL" -) -data <- cdisc_data_connector( - connection = data_connection(open_fun = callable_function(function() "open function")), - connectors = list(adsl, adae) -) -} diff --git a/man/cdisc_data_file.Rd b/man/cdisc_data_file.Rd deleted file mode 100644 index 045260a87..000000000 --- a/man/cdisc_data_file.Rd +++ /dev/null @@ -1,44 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/cdisc_data.R -\name{cdisc_data_file} -\alias{cdisc_data_file} -\title{Load \code{TealData} object from a file} -\usage{ -cdisc_data_file(path, code = get_code(path)) -} -\arguments{ -\item{path}{A (\code{connection}) or a (\code{character})\cr -string giving the pathname of the file or URL to read from. "" indicates the connection \code{stdin}.} - -\item{code}{(\code{character})\cr -reproducible code to re-create object} -} -\value{ -\code{TealData} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -} -\examples{ -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(scda) - - # code> - ADSL <- synthetic_cdisc_data('latest')$adsl - ADTTE <- synthetic_cdisc_data('latest')$adtte - - cdisc_data( - cdisc_dataset(\"ADSL\", ADSL), cdisc_dataset(\"ADTTE\", ADTTE), - code = \"ADSL <- synthetic_cdisc_data('latest')$adsl - ADTTE <- synthetic_cdisc_data('latest')$adtte\", - check = FALSE - ) - # )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{metadata}{(named \code{list} or \code{NULL}) field containing metadata about the dataset. -Each element of the list should be atomic and length one.} -} -\value{ -(\code{CDISCTealDataset}) a dataset with connected metadata -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Function that creates \code{CDISCTealDataset} object -} -\examples{ -library(scda) - -ADSL <- synthetic_cdisc_data("latest")$adsl - -cdisc_dataset("ADSL", ADSL, metadata = list(type = "scda", date = "latest")) -} diff --git a/man/cdisc_dataset_connector.Rd b/man/cdisc_dataset_connector.Rd deleted file mode 100644 index d149fefbf..000000000 --- a/man/cdisc_dataset_connector.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{cdisc_dataset_connector} -\alias{cdisc_dataset_connector} -\title{Create a new \code{CDISCTealDatasetConnector} object} -\usage{ -cdisc_dataset_connector( - dataname, - pull_callable, - keys, - parent = if (identical(dataname, "ADSL")) character(0) else "ADSL", - label = character(0), - code = character(0), - script = character(0), - vars = list(), - metadata = NULL -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{pull_callable}{(\code{CallableFunction})\cr -function with necessary arguments set to fetch data from connection.} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{parent}{(\code{character}, optional) parent dataset name} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{code}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{vars}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} -} -\value{ -new \code{CDISCTealDatasetConnector} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create \code{CDISCTealDatasetConnector} from \link{callable_function}. -} diff --git a/man/cdisc_dataset_file.Rd b/man/cdisc_dataset_file.Rd deleted file mode 100644 index 35860ebc0..000000000 --- a/man/cdisc_dataset_file.Rd +++ /dev/null @@ -1,37 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealDataset.R -\name{cdisc_dataset_file} -\alias{cdisc_dataset_file} -\title{Load \code{CDISCTealDataset} object from a file} -\usage{ -cdisc_dataset_file(path, code = get_code(path)) -} -\arguments{ -\item{path}{(\code{character}) string giving the pathname of the file to read from.} - -\item{code}{(\code{character}) reproducible code to re-create object} -} -\value{ -(\code{CDISCTealDataset}) object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Please note that the script has to end with a call creating desired object. The error will be raised otherwise. -} -\examples{ -# simple example -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(teal.data) - library(scda) - - cdisc_dataset(dataname = \"ADSL\", - x = synthetic_cdisc_data('latest')$adsl, - code = \"library(scda)\nADSL <- synthetic_cdisc_data('latest')$adsl\")" - ), - con = file_example -) -x <- cdisc_dataset_file(file_example, code = character(0)) -get_code(x) -} diff --git a/man/code_dataset_connector.Rd b/man/code_dataset_connector.Rd deleted file mode 100644 index 3146944bc..000000000 --- a/man/code_dataset_connector.Rd +++ /dev/null @@ -1,104 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{code_dataset_connector} -\alias{code_dataset_connector} -\alias{code_cdisc_dataset_connector} -\title{Code \code{TealDatasetConnector}} -\usage{ -code_dataset_connector( - dataname, - code, - keys = character(0), - label = character(0), - mutate_code = character(0), - mutate_script = character(0), - metadata = NULL, - ... -) - -code_cdisc_dataset_connector( - dataname, - code, - keys = get_cdisc_keys(dataname), - parent = if (identical(dataname, "ADSL")) character(0L) else "ADSL", - label = character(0), - mutate_code = character(0), - metadata = NULL, - ... -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{code}{(\code{character})\cr -String containing the code to produce the object. -The code must end in a call to the object.} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{mutate_code}{(\code{character})\cr -String containing the code used to mutate the object -after it is produced.} - -\item{mutate_script}{(\code{character})\cr -Alternatively to \code{mutate_code} - location of the file containing modification code. -Can't be used simultaneously with \code{mutate_script}.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{...}{Additional arguments applied to pull function. -In case when this object code depends on the \code{raw_data} from the other -\code{TealDataset}, \code{TealDatasetConnector} object(s) or other constant value, -this/these object(s) should be included. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create a \code{TealDatasetConnector} from a string of code. - -Create a \code{CDISCTealDatasetConnector} from a string of code with keys -assigned automatically by \code{dataname}. -} -\examples{ -library(scda) -x <- code_dataset_connector( - dataname = "ADSL", - keys = get_cdisc_keys("ADSL"), - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl; ADSL" -) - -x$get_code() - -mutate_dataset(x, code = "ADSL$new_variable <- 1") -x$get_code() - -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "seed <- 1; ADSL <- radsl(cached = TRUE, seed = seed)\nADSL" - ), - con = file_example -) - -y <- code_dataset_connector( - dataname = "ADSL", - keys = get_cdisc_keys("ADSL"), - code = paste0(readLines(file_example), collapse = "\n") -) -} diff --git a/man/code_exclude.Rd b/man/code_exclude.Rd index 5a3d94b0c..535066016 100644 --- a/man/code_exclude.Rd +++ b/man/code_exclude.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_code.R +% Please edit documentation in R/utils-get_code.R \name{code_exclude} \alias{code_exclude} \title{Exclude from code} diff --git a/man/code_from_script.Rd b/man/code_from_script.Rd index 88c33f0b6..8734fd417 100644 --- a/man/code_from_script.Rd +++ b/man/code_from_script.Rd @@ -11,11 +11,7 @@ code_from_script(code, script, dataname = NULL) an R code to be evaluated or a \code{PythonCodeClass} created using \link{python_code}.} \item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} +path of the script} } \value{ code (\code{character}) diff --git a/man/csv_dataset_connector.Rd b/man/csv_dataset_connector.Rd deleted file mode 100644 index bec14b649..000000000 --- a/man/csv_dataset_connector.Rd +++ /dev/null @@ -1,87 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{csv_dataset_connector} -\alias{csv_dataset_connector} -\alias{csv_cdisc_dataset_connector} -\title{\code{csv} \code{TealDatasetConnector}} -\usage{ -csv_dataset_connector( - dataname, - file, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "csv", file = file), - ... -) - -csv_cdisc_dataset_connector( - dataname, - file, - keys = get_cdisc_keys(dataname), - parent = if (identical(dataname, "ADSL")) character(0L) else "ADSL", - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "csv", file = file), - ... -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{file}{(\code{character})\cr -path to (\verb{.csv)} (or general delimited) file that contains \code{data.frame} object} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{code}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{...}{(\code{optional})\cr -additional arguments applied to pull function (\code{readr::read_delim}) by default -\code{delim = ","}.} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create a \code{TealDatasetConnector} from \code{csv} (or general delimited file). - -Create a \code{CDISCTealDatasetConnector} from \code{csv} (or general delimited) file -with keys and parent name assigned automatically by \code{dataname}. -} -\examples{ -\dontrun{ -x <- csv_dataset_connector( - dataname = "ADSL", - file = "path/to/file.csv", - delim = ",", - col_types = quote(readr::cols(AGE = "i")) -) -x$get_code() -} -} diff --git a/man/data_connection.Rd b/man/data_connection.Rd deleted file mode 100644 index f9bc5840e..000000000 --- a/man/data_connection.Rd +++ /dev/null @@ -1,55 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataConnection.R -\name{data_connection} -\alias{data_connection} -\title{The constructor for \code{TealDataConnection} class.} -\usage{ -data_connection( - open_fun = NULL, - close_fun = NULL, - ping_fun = NULL, - if_conn_obj = FALSE -) -} -\arguments{ -\item{open_fun}{(\code{CallableFunction}) function to open connection} - -\item{close_fun}{(\code{CallableFunction}) function to close connection} - -\item{ping_fun}{(\code{CallableFunction}) function to ping connection} - -\item{if_conn_obj}{optional, (\code{logical}) whether to store \code{conn} object returned from opening} -} -\value{ -\code{TealDataConnection} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -open_fun <- callable_function(data.frame) # define opening function -open_fun$set_args(list(x = 1:5)) # define fixed arguments to opening function - -close_fun <- callable_function(sum) # define closing function -close_fun$set_args(list(x = 1:5)) # define fixed arguments to closing function - -ping_fun <- callable_function(function() TRUE) - -x <- data_connection( # define connection - ping_fun = ping_fun, # define ping function - open_fun = open_fun, # define opening function - close_fun = close_fun # define closing function -) - -x$set_open_args(args = list(y = letters[1:5])) # define additional arguments if necessary - -x$open() # call opening function -x$get_open_call() # check reproducible R code - -# get data from connection via TealDataConnector$get_dataset() -\dontrun{ -x$open(args = list(x = 1:5, y = letters[1:5])) # able to call opening function with arguments -x$close() # call closing function -} - -} diff --git a/man/data_label-set.Rd b/man/data_label-set.Rd deleted file mode 100644 index 0e27af307..000000000 --- a/man/data_label-set.Rd +++ /dev/null @@ -1,25 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_label.R -\name{data_label<-} -\alias{data_label<-} -\title{Set dataset label attribute} -\usage{ -data_label(x) <- value -} -\arguments{ -\item{x}{\code{data.frame} for which attribute is set} - -\item{value}{(\code{character}) label} -} -\value{ -modified \code{x} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -library(scda) -x <- synthetic_cdisc_data("latest")$adsl -data_label(x) <- "My custom label" -data_label(x) -} diff --git a/man/data_label.Rd b/man/data_label.Rd deleted file mode 100644 index f143b737b..000000000 --- a/man/data_label.Rd +++ /dev/null @@ -1,21 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_label.R -\name{data_label} -\alias{data_label} -\title{Get dataset label attribute} -\usage{ -data_label(data) -} -\arguments{ -\item{data}{\code{data.frame} from which attribute is extracted} -} -\value{ -(\code{character}) label or \code{NULL} if it is missing -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -library(scda) -data_label(synthetic_cdisc_data("latest")$adsl) -} diff --git a/man/dataset.Rd b/man/dataset.Rd deleted file mode 100644 index 2e12f78d9..000000000 --- a/man/dataset.Rd +++ /dev/null @@ -1,105 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/MAETealDataset.R, R/TealDataset.R -\name{dataset.MultiAssayExperiment} -\alias{dataset.MultiAssayExperiment} -\alias{dataset} -\alias{dataset.data.frame} -\title{S3 method to construct an \code{MAETealDataset} object from \code{MultiAssayExperiment}} -\usage{ -\method{dataset}{MultiAssayExperiment}( - dataname, - x, - keys = character(0), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL -) - -dataset( - dataname, - x, - keys = character(0), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL -) - -\method{dataset}{data.frame}( - dataname, - x, - keys = character(0), - label = data_label(x), - code = character(0), - vars = list(), - metadata = NULL -) -} -\arguments{ -\item{dataname}{(\code{character}) a given name for the dataset, it cannot contain spaces} - -\item{x}{(\code{data.frame} or \code{MultiAssayExperiment}) object from which the dataset will be created} - -\item{keys}{optional, (\code{character}) vector with primary keys} - -\item{label}{(\code{character}) label to describe the dataset} - -\item{code}{(\code{character}) a character string defining the code needed to -produce the data set in \code{x}} - -\item{vars}{(named \code{list}) in case when this object code depends on other \code{TealDataset} -object(s) or other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{metadata}{(named \code{list} or \code{NULL}) field containing metadata about the dataset. -Each element of the list should be atomic and length one.} -} -\value{ -\code{\link{TealDataset}} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -# Simple example -utils::data(miniACC, package = "MultiAssayExperiment") -mae_d <- dataset( - "MAE", - miniACC, - keys = c("STUDYID", "USUBJID"), - metadata = list(type = "example") -) -mae_d$get_dataname() -mae_d$get_dataset_label() -mae_d$get_metadata() -mae_d$get_code() -mae_d$get_raw_data() -# Simple example -dataset("iris", iris) - -# Example with more arguments -library(scda) -\dontrun{ -ADSL <- synthetic_cdisc_data("latest")$adsl -ADSL_dataset <- dataset(dataname = "ADSL", x = ADSL) - -ADSL_dataset$get_dataname() - -ADSL_dataset <- dataset( - dataname = "ADSL", - x = ADSL, - label = "AdAM subject-level dataset", - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl", - metadata = list(type = "synthetic data") -) -ADSL_dataset$get_metadata() -ADSL_dataset$get_dataset_label() -ADSL_dataset$get_code() -} -} diff --git a/man/dataset_connector.Rd b/man/dataset_connector.Rd deleted file mode 100644 index 02918365a..000000000 --- a/man/dataset_connector.Rd +++ /dev/null @@ -1,86 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{dataset_connector} -\alias{dataset_connector} -\title{Create a new \code{TealDatasetConnector} object} -\usage{ -dataset_connector( - dataname, - pull_callable, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - vars = list(), - metadata = NULL -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{pull_callable}{(\code{CallableFunction})\cr -function with necessary arguments set to fetch data from connection.} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{code}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{vars}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} -} -\value{ -new \code{TealDatasetConnector} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create \code{TealDatasetConnector} from \link{callable_function}. -} -\examples{ -library(MultiAssayExperiment) -# data.frame example -pull_fun2 <- callable_function(data.frame) -pull_fun2$set_args(args = list(a = c(1, 2, 3))) -dataset_connector("test", pull_fun2) - -# MultiAssayExperiment example -pull_fun <- callable_function( - function() { - library("MultiAssayExperiment") - data("miniACC") - return(miniACC) - } -) -dataset_connector( - "miniacc", - pull_fun, - code = 'library("MultiAssayExperiment"); data("miniACC"); return(miniACC)' -) -} diff --git a/man/dataset_connector_file.Rd b/man/dataset_connector_file.Rd deleted file mode 100644 index 5ef09c626..000000000 --- a/man/dataset_connector_file.Rd +++ /dev/null @@ -1,61 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{dataset_connector_file} -\alias{dataset_connector_file} -\alias{cdisc_dataset_connector_file} -\title{Load \code{TealDatasetConnector} object from a file} -\usage{ -dataset_connector_file(path) - -cdisc_dataset_connector_file(path) -} -\arguments{ -\item{path}{(\code{character}) string giving the pathname of the file to read from.} -} -\value{ -\code{TealDatasetConnector} object - -\code{CDISCTealDatasetConnector} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Please note that the script has to end with a call creating desired object. The error will -be raised otherwise. - -Please note that the script has to end with a call creating desired object. The error will -be raised otherwise. -} -\examples{ -# simple example -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(teal.data) - library(scda) - - pull_callable <- callable_function(function() {synthetic_cdisc_data('latest')$adsl}) - dataset_connector(\"ADSL\", pull_callable, get_cdisc_keys(\"ADSL\"))" - ), - con = file_example -) -x <- dataset_connector_file(file_example) -get_code(x) -# simple example -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(teal.data) - library(scda) - - pull_callable <- callable_function(function() {synthetic_cdisc_data('latest')$adsl}) - cdisc_dataset_connector(\"ADSL\", pull_callable, get_cdisc_keys(\"ADSL\"))" - ), - con = file_example -) -x <- cdisc_dataset_connector_file(file_example) -get_code(x) -} diff --git a/man/dataset_file.Rd b/man/dataset_file.Rd deleted file mode 100644 index 64ec4ad1f..000000000 --- a/man/dataset_file.Rd +++ /dev/null @@ -1,54 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataset.R -\name{dataset_file} -\alias{dataset_file} -\title{Load \code{TealDataset} object from a file} -\usage{ -dataset_file(path, code = get_code(path)) -} -\arguments{ -\item{path}{(\code{character}) string giving the pathname of the file to read from.} - -\item{code}{(\code{character}) reproducible code to re-create object} -} -\value{ -\code{TealDataset} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Please note that the script has to end with a call creating desired object. The error will be raised otherwise. -} -\examples{ -# simple example -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(teal.data) - dataset(dataname = \"iris\", - x = iris, - code = \"iris\")" - ), - con = file_example -) -x <- dataset_file(file_example, code = character(0)) -get_code(x) - -# custom code -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(teal.data) - - # code> - x <- iris - x$a1 <- 1 - x$a2 <- 2 - - # }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{func_name}{(\code{name})\cr -for internal purposes, please keep it default} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{...}{Additional arguments applied to pull function. -In case when this object code depends on the \code{raw_data} from the other -\code{TealDataset}, \code{TealDatasetConnector} object(s) or other constant value, -this/these object(s) should be included. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create a \code{TealDatasetConnector} from \code{function} and its arguments. - -Create a \code{CDISCTealDatasetConnector} from \code{function} and its arguments -with keys and parent name assigned automatically by \code{dataname}. -} -\examples{ -my_data <- function(...) { - data.frame( - ID = paste0("ABC_", seq_len(10)), - var1 = rnorm(n = 10), - var2 = rnorm(n = 10), - var3 = rnorm(n = 10) - ) -} -y <- fun_dataset_connector( - dataname = "XYZ", - fun = my_data -) - -y$get_code() - -y$pull() - -get_raw_data(y) -} diff --git a/man/get_attrs.Rd b/man/get_attrs.Rd deleted file mode 100644 index 422577e54..000000000 --- a/man/get_attrs.Rd +++ /dev/null @@ -1,50 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_attrs.R -\name{get_attrs} -\alias{get_attrs} -\alias{get_attrs.TealDataset} -\title{Get dataset attributes} -\usage{ -get_attrs(x) - -\method{get_attrs}{TealDataset}(x) -} -\arguments{ -\item{x}{an object of (\code{TealDataset}) class} -} -\value{ -named \code{list} of object attributes -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Get dataset attributes in form of named list. -} -\examples{ -# TealDataset -------- - -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl - -x1 <- dataset("ADSL", x = ADSL, label = "custom label") -get_attrs(x1) - -x2 <- dataset( - "ADSL", - x = ADSL, - keys = get_cdisc_keys("ADSL"), - label = "custom label" -) -get_attrs(x2) - -# CDISCTealDataset -------- - -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl -x3 <- cdisc_dataset( - "ADSL", - x = ADSL, - keys = get_cdisc_keys("ADSL"), - label = "custom label" -) -get_attrs(x3) -} diff --git a/man/get_binding_name.Rd b/man/get_binding_name.Rd deleted file mode 100644 index 75552a919..000000000 --- a/man/get_binding_name.Rd +++ /dev/null @@ -1,31 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallableFunction.R -\name{get_binding_name} -\alias{get_binding_name} -\title{Gets the name of the binding} -\usage{ -get_binding_name(object, envir) -} -\arguments{ -\item{object}{(R object)\cr -any R object} - -\item{envir}{(\code{environment})\cr -if origin of the object is known then should be provided for -more precise search} -} -\value{ -character -} -\description{ -Gets the name of the object by finding its origin. -Depending on type of object function uses different methods -to obtain original location. If no \code{env} is specified then -object is tracked by \code{substitute} along the \code{sys.frames}. -If \code{env} is specified then search is limited to specified -environment.\cr -} -\note{ -Raises an error if the object is not found in the environment. -} -\keyword{internal} diff --git a/man/get_cdisc_keys.Rd b/man/get_cdisc_keys.Rd deleted file mode 100644 index a0b6aad12..000000000 --- a/man/get_cdisc_keys.Rd +++ /dev/null @@ -1,20 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_label.R -\name{get_cdisc_keys} -\alias{get_cdisc_keys} -\title{Function that returns the default keys for a \code{CDISC} dataset by name} -\usage{ -get_cdisc_keys(dataname) -} -\arguments{ -\item{dataname}{name of the \code{CDISC} dataset} -} -\value{ -\code{keys} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -get_cdisc_keys("ADSL") -} diff --git a/man/get_code_single.Rd b/man/get_code_single.Rd index e5e3f9275..f3b30281e 100644 --- a/man/get_code_single.Rd +++ b/man/get_code_single.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_code.R +% Please edit documentation in R/utils-get_code.R \name{get_code_single} \alias{get_code_single} \title{Get code} diff --git a/man/get_dataname.Rd b/man/get_dataname.Rd deleted file mode 100644 index 85e76042c..000000000 --- a/man/get_dataname.Rd +++ /dev/null @@ -1,30 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_dataname.R -\name{get_dataname} -\alias{get_dataname} -\alias{get_dataname.TealDataAbstract} -\alias{get_dataname.TealDatasetConnector} -\alias{get_dataname.TealDataset} -\title{S3 method for getting a dataname(s) of -(\code{TealDataAbstract}, (\code{TealDatasetConnector} or -\code{TealDataset}) R6 object} -\usage{ -get_dataname(x) - -\method{get_dataname}{TealDataAbstract}(x) - -\method{get_dataname}{TealDatasetConnector}(x) - -\method{get_dataname}{TealDataset}(x) -} -\arguments{ -\item{x}{(\code{TealDataAbstract}, \code{TealDatasetConnector} or -\code{TealDataset}) object} -} -\value{ -dataname (\code{character}) A given name for the dataset(s) -it may not contain spaces -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} diff --git a/man/get_dataset.Rd b/man/get_dataset.Rd deleted file mode 100644 index 308a94ce6..000000000 --- a/man/get_dataset.Rd +++ /dev/null @@ -1,81 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_dataset.R -\name{get_dataset} -\alias{get_dataset} -\alias{get_dataset.TealDatasetConnector} -\alias{get_dataset.TealDataset} -\alias{get_dataset.TealDataAbstract} -\title{Get dataset from \code{TealDatasetConnector}} -\usage{ -get_dataset(x, dataname) - -\method{get_dataset}{TealDatasetConnector}(x, dataname = NULL) - -\method{get_dataset}{TealDataset}(x, dataname = NULL) - -\method{get_dataset}{TealDataAbstract}(x, dataname = NULL) -} -\arguments{ -\item{x}{(\code{TealDatasetConnector} or \code{TealDatasetConnector} or \code{TealDataAbstract})} - -\item{dataname}{(\code{character}) a name of dataset to be retrieved} -} -\value{ -(\code{TealDataset}) -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -Get dataset from \code{TealDatasetConnector} -} -\details{ -See \code{help(TealDataConnector)} and \code{help(TealData)} for more complex examples. -} -\examples{ - -# TealDatasetConnector -------- -library(scda) -pull_fun_adae <- callable_function( - function() { - synthetic_cdisc_data("latest")$adae - } -) - -ADSL <- synthetic_cdisc_data("latest")$adsl - -dc <- dataset_connector( - dataname = "ADAE", pull_callable = pull_fun_adae, - keys = get_cdisc_keys("ADSL") -) - -\dontrun{ -load_dataset(dc) -get_dataset(dc) -} - - -# TealDataset -------- -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl -x <- dataset("ADSL", ADSL) - -get_dataset(x) - -# TealData (not containing connectors) -------- -library(scda) -latest_data <- synthetic_cdisc_data("latest") -adsl <- cdisc_dataset( - dataname = "ADSL", - x = latest_data$adsl, - code = "library(scda)\nADSL <- synthetic_cdisc_data(\"latest\")$adsl" -) - -adae <- cdisc_dataset( - dataname = "ADAE", - x = latest_data$adsl, - code = "library(scda)\nADTTE <- synthetic_cdisc_data(\"latest\")$adsl" -) - -rd <- teal.data:::TealData$new(adsl, adae) -get_dataset(rd, "ADSL") -} diff --git a/man/get_dataset_label.Rd b/man/get_dataset_label.Rd deleted file mode 100644 index 4f6a397bc..000000000 --- a/man/get_dataset_label.Rd +++ /dev/null @@ -1,39 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_dataset_label.R -\name{get_dataset_label} -\alias{get_dataset_label} -\alias{get_dataset_label.TealDatasetConnector} -\alias{get_dataset_label.TealDataset} -\title{S3 method for getting a label of -(\code{TealDatasetConnector} or \code{TealDataset}) R6 object} -\usage{ -get_dataset_label(x) - -\method{get_dataset_label}{TealDatasetConnector}(x) - -\method{get_dataset_label}{TealDataset}(x) -} -\arguments{ -\item{x}{(\code{TealDatasetConnector} or \code{TealDataset}) R6 object} -} -\value{ -label (\code{character}) Label to describe the dataset -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -fun <- callable_function(data.frame) -fun$set_args(list(c1 = seq_len(10))) - -x <- dataset_connector( - pull_callable = fun, - dataname = "ADSL", - label = "My custom label" -) -get_dataset_label(x) -library(scda) -ADSL <- synthetic_cdisc_data("latest")$adsl -ADSL_dataset <- dataset(dataname = "ADSL", x = ADSL, label = "My custom label") -get_dataset_label(ADSL_dataset) -} diff --git a/man/get_datasets.Rd b/man/get_datasets.Rd deleted file mode 100644 index 2b2ac481e..000000000 --- a/man/get_datasets.Rd +++ /dev/null @@ -1,119 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_datasets.R -\name{get_datasets} -\alias{get_datasets} -\alias{get_datasets.TealDataAbstract} -\alias{get_datasets.TealDatasetConnector} -\alias{get_datasets.TealDataset} -\title{Get a \code{\link{TealDataset}} objects.} -\usage{ -get_datasets(x) - -\method{get_datasets}{TealDataAbstract}(x) - -\method{get_datasets}{TealDatasetConnector}(x) - -\method{get_datasets}{TealDataset}(x) -} -\arguments{ -\item{x}{(\code{\link{TealData}})\cr -object containing datasets.} -} -\value{ -\code{list} or \code{TealDataset} objects -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ - -# TealData -------- -library(scda) -latest_data <- synthetic_cdisc_data("latest") -adsl <- cdisc_dataset( - dataname = "ADSL", - x = latest_data$adsl, - code = "library(scda)\nADSL <- synthetic_cdisc_data(\"latest\")$adsl" -) - -adae <- cdisc_dataset( - dataname = "ADAE", - x = latest_data$adae, - code = "library(scda)\nADTTE <- synthetic_cdisc_data(\"latest\")$adae" -) - -rd <- cdisc_data(adsl, adae) -get_datasets(rd) - -# TealDataConnector -------- -adsl_cf <- callable_function(function() synthetic_cdisc_data("latest")$adsl) -adsl <- cdisc_dataset_connector( - dataname = "ADSL", - pull_callable = adsl_cf, - keys = get_cdisc_keys("ADSL") -) -adlb_cf <- callable_function(function() synthetic_cdisc_data("latest")$adlb) -adlb <- cdisc_dataset_connector( - dataname = "ADLB", - pull_callable = adlb_cf, - keys = get_cdisc_keys("ADLB") -) - -rdc <- relational_data_connector( - connection = data_connection(), - connectors = list(adsl, adlb) -) - -rdc$set_ui(function(id, connection, connectors) p("Example UI")) -rdc$set_server( - function(id, connection, connectors) { - moduleServer( - id = id, - module = function(input, output, session) { - # Note this is simplified as we are not opening a real connection here - for (connector in connectors) { - set_args(connector, args = list(name = input$name)) - # pull each dataset - connector$get_server()(id = connector$get_dataname()) - if (connector$is_failed()) { - break - } - } - } - ) - } -) -\dontrun{ -load_datasets(rdc) -get_datasets(rdc) -} - -# TealData -------- -\dontrun{ -drc <- cdisc_data(rdc, adae) -get_datasets(drc) -} - -# TealDatasetConnector -------- -library(scda) -adsl_cf <- callable_function( - function() { - synthetic_cdisc_data("latest")$adsl - } -) -rdc <- cdisc_dataset_connector("ADSL", adsl_cf, keys = get_cdisc_keys("ADSL")) -\dontrun{ -load_datasets(rdc) -get_datasets(rdc) -} - -# TealDataset -------- -library(scda) -adsl <- cdisc_dataset( - dataname = "ADSL", - x = synthetic_cdisc_data("latest")$adsl, - code = "library(scda)\nADSL <- synthetic_cdisc_data(\"latest\")$adsl" -) - -get_datasets(adsl) -} diff --git a/man/get_key_duplicates.Rd b/man/get_key_duplicates.Rd deleted file mode 100644 index 38b4cc482..000000000 --- a/man/get_key_duplicates.Rd +++ /dev/null @@ -1,52 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_key_duplicates.R -\name{get_key_duplicates} -\alias{get_key_duplicates} -\alias{get_key_duplicates.TealDataset} -\alias{get_key_duplicates.data.frame} -\title{S3 generic for creating an information summary about the duplicate key values in a dataset} -\usage{ -get_key_duplicates(dataset, keys = NULL) - -\method{get_key_duplicates}{TealDataset}(dataset, keys = NULL) - -\method{get_key_duplicates}{data.frame}(dataset, keys = NULL) -} -\arguments{ -\item{dataset}{\code{TealDataset} or \code{data.frame} a dataset, which will be tested} - -\item{keys}{\code{character} vector of variable names in \code{dataset} consisting the key -or \code{keys} object, which does have a \code{primary} element with a vector of variable -names in \code{dataset} consisting the key. Optional, default: NULL} -} -\value{ -a \code{tibble} with variables consisting the key and \code{row_no} and \code{duplicates_count} columns -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -The information summary provides row numbers and number of duplicates -for each duplicated key value. -} -\note{ -Raises an exception when this function cannot determine the primary key columns of the tested object. -} -\examples{ -library(scda) - -adsl <- synthetic_cdisc_data("latest")$adsl -# create a TealDataset with default keys -rel_adsl <- cdisc_dataset("ADSL", adsl) -get_key_duplicates(rel_adsl) - -df <- as.data.frame( - list(a = c("a", "a", "b", "b", "c"), b = c(1, 2, 3, 3, 4), c = c(1, 2, 3, 4, 5)) -) -res <- get_key_duplicates(df, keys = c("a", "b")) # duplicated keys are in rows 3 and 4 -print(res) # prints a tibble -\dontrun{ -get_key_duplicates(df) # raises an exception, because keys are missing with no default -} - -} diff --git a/man/get_key_duplicates_util.Rd b/man/get_key_duplicates_util.Rd deleted file mode 100644 index e9a26f736..000000000 --- a/man/get_key_duplicates_util.Rd +++ /dev/null @@ -1,42 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_key_duplicates.R -\name{get_key_duplicates_util} -\alias{get_key_duplicates_util} -\title{Creates a duplicate keys information summary.} -\usage{ -get_key_duplicates_util(dataframe, keys) -} -\arguments{ -\item{dataframe}{dataframe} - -\item{keys}{\code{character} vector of variable names consisting the key to the \code{data.frame}} -} -\value{ -\code{data.frame} with a duplicate keys information summary -} -\description{ -Creates a duplicate keys information summary. -} -\details{ -Accepts a list of variable names - \code{keys}, which are treated as the -key to the \code{data.frame} argument. An instance of duplicated key is -defined as two rows, which have the same values in columns defined by \code{keys}. -Per each key value with duplicates returns a row in a \code{tibble}. The return table -has columns corresponding to the variable names passed in \code{keys} and -two additional columns: \code{rows} and \code{n}, which provide -information about row numbers of the original dataframe, which contain duplicated keys -and total duplicates counts. -} -\examples{ -df <- data.frame( - a = c("a", "a", "b", "b", "c"), - b = c(1, 2, 3, 3, 4), - c = c(1, 2, 3, 4, 5) -) -res <- teal.data:::get_key_duplicates_util(df, keys = c("a", "b")) -print(res) # duplicated keys are in rows 3 and 4 -} -\seealso{ -\link{get_key_duplicates} -} -\keyword{internal} diff --git a/man/get_keys.Rd b/man/get_keys.Rd deleted file mode 100644 index 1035f4122..000000000 --- a/man/get_keys.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_keys.R -\name{get_keys} -\alias{get_keys} -\alias{get_keys.TealDataset} -\alias{get_keys.TealDatasetConnector} -\alias{get_keys.TealDataAbstract} -\title{Get dataset primary keys} -\usage{ -get_keys(x, ...) - -\method{get_keys}{TealDataset}(x, ...) - -\method{get_keys}{TealDatasetConnector}(x, ...) - -\method{get_keys}{TealDataAbstract}(x, dataname, ...) -} -\arguments{ -\item{x}{an object of \code{TealDataset} or \code{TealDatasetConnector} class} - -\item{...}{not used, only for support of S3} - -\item{dataname}{(\code{character}) name of dataset to return keys for} -} -\value{ -(\code{character}) vector of column names -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Get dataset primary keys -} -\examples{ -# TealDataset -------- - -library(scda) -get_keys( - dataset( - "ADSL", - synthetic_cdisc_data("latest")$adsl, - keys = get_cdisc_keys("ADSL"), - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" - ) -) -# TealDatasetConnector -------- - -library(scda) -pull_fun_adsl <- callable_function( - function() { - synthetic_cdisc_data("latest")$adsl - } -) -get_keys( - dataset_connector( - "ADSL", - pull_fun_adsl, - keys = get_cdisc_keys("ADSL"), - ) -) -# TealData -------- - -get_keys( - teal_data( - dataset("x", data.frame(x1 = 1:10, y1 = 11:20), keys = "x1"), - dataset("y", data.frame(x2 = 1:10, y2 = 11:20), keys = "x2") - ), - "x" -) -} diff --git a/man/get_labels.Rd b/man/get_labels.Rd deleted file mode 100644 index 5802d8aaf..000000000 --- a/man/get_labels.Rd +++ /dev/null @@ -1,27 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/data_label.R -\name{get_labels} -\alias{get_labels} -\title{Extracts dataset and variable labels from a dataset.} -\usage{ -get_labels(data, fill = TRUE) -} -\arguments{ -\item{data}{(\code{data.frame}) table to extract the labels from} - -\item{fill}{(\code{logical(1)}) if \code{TRUE}, the function will return variable names for columns with non-existent labels; -otherwise will return \code{NA} for them} -} -\value{ -\code{list} with two keys: \code{dataset_labels} and \code{column_labels} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ -iris_with_labels <- iris -attr(iris_with_labels, "label") <- "Custom iris dataset with labels" -attr(iris_with_labels["Sepal.Length"], "label") <- c(`Sepal.Length` = "Sepal Length") -get_labels(iris_with_labels, fill = TRUE) -get_labels(iris_with_labels, fill = FALSE) -} diff --git a/man/get_code.Rd b/man/get_preprocessing_code.Rd similarity index 67% rename from man/get_code.Rd rename to man/get_preprocessing_code.Rd index 10a78bbf7..141276073 100644 --- a/man/get_code.Rd +++ b/man/get_preprocessing_code.Rd @@ -1,22 +1,10 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_code.R -\name{get_code} -\alias{get_code} -\alias{get_code.TealDatasetConnector} -\alias{get_code.TealDataset} -\alias{get_code.TealDataAbstract} -\alias{get_code.default} +% Please edit documentation in R/utils-get_code.R +\name{get_preprocessing_code} +\alias{get_preprocessing_code} \title{Get code} \usage{ -get_code(x, ...) - -\method{get_code}{TealDatasetConnector}(x, deparse = TRUE, ...) - -\method{get_code}{TealDataset}(x, deparse = TRUE, ...) - -\method{get_code}{TealDataAbstract}(x, dataname = character(0), deparse = TRUE, ...) - -\method{get_code}{default}( +get_preprocessing_code( x, exclude_comments = TRUE, read_sources = TRUE, @@ -29,12 +17,6 @@ get_code(x, ...) \arguments{ \item{x}{(\code{\link{TealDatasetConnector}} or \code{\link{TealDataset}}). If of class \code{character} will be treated as file to read.} -\item{...}{not used, only for support of S3} - -\item{deparse}{(\code{logical}) whether return deparsed form of a call} - -\item{dataname}{(\code{character}) Name of dataset to return code for.} - \item{exclude_comments}{(\code{logical}) whether exclude commented-out lines of code. Lines to be excluded should be ended with \verb{# nocode}. For multiple line exclusions one should enclose ignored block of code with \verb{# nocode>} and \verb{# )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#deprecated}{\figure{lifecycle-deprecated.svg}{options: alt='[Deprecated]'}}}{\strong{[Deprecated]}} -} -\examples{ -# Simple example -utils::data(miniACC, package = "MultiAssayExperiment") -mae_d <- dataset("MAE", miniACC) -mae_d$get_dataname() -mae_d$get_dataset_label() -mae_d$get_code() -mae_d$get_raw_data() -} diff --git a/man/mutate_data.Rd b/man/mutate_data.Rd deleted file mode 100644 index 3e5bc78bb..000000000 --- a/man/mutate_data.Rd +++ /dev/null @@ -1,47 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mutate_dataset.R -\name{mutate_data} -\alias{mutate_data} -\alias{mutate_data.TealDataAbstract} -\title{Mutate data by code} -\usage{ -mutate_data(x, code = character(0), script = character(0), vars = list()) - -\method{mutate_data}{TealDataAbstract}(x, code = character(0), script = character(0), vars = list()) -} -\arguments{ -\item{x}{(\code{TealDataAbstract})\cr -object.} - -\item{code}{(\code{character})\cr -Code to mutate the dataset. Must contain the \code{dataset$dataname}. Or can also be an object -of class \code{PythonCodeClass} returned by \code{\link{python_code}}.} - -\item{script}{(\code{character})\cr -file that contains R Code that can be read using \code{\link{read_script}}. -Preferred before \code{code} argument.} - -\item{vars}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} -} -\value{ -modified \code{x} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Code used in this mutation is not linked to particular -but refers to all datasets. -Consequence of this is that when using \verb{get_code()} this -part of the code will be returned for each dataset specified. This method -should be used only if particular call involve changing multiple datasets. -Otherwise please use \code{mutate_dataset}. -Execution of the code is delayed after datasets are pulled -(\code{isTRUE(is_pulled)}). -} diff --git a/man/mutate_dataset.Rd b/man/mutate_dataset.Rd deleted file mode 100644 index 7e120e7ca..000000000 --- a/man/mutate_dataset.Rd +++ /dev/null @@ -1,106 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/mutate_dataset.R -\name{mutate_dataset} -\alias{mutate_dataset} -\alias{mutate_dataset.TealDataset} -\alias{mutate_dataset.TealDatasetConnector} -\alias{mutate_dataset.TealDataAbstract} -\title{Mutate dataset by code} -\usage{ -mutate_dataset(x, ...) - -\method{mutate_dataset}{TealDataset}( - x, - code = character(0), - script = character(0), - vars = list(), - ... -) - -\method{mutate_dataset}{TealDatasetConnector}( - x, - code = character(0), - script = character(0), - vars = list(), - ... -) - -\method{mutate_dataset}{TealDataAbstract}( - x, - dataname, - code = character(0), - script = character(0), - vars = list(), - ... -) -} -\arguments{ -\item{x}{(\code{TealDataset})\cr -object.} - -\item{...}{not used, only for support of S3} - -\item{code}{(\code{character})\cr -Code to mutate the dataset. Must contain the \code{dataset$dataname}. Or can also be an object -of class \code{PythonCodeClass} returned by \code{\link{python_code}}.} - -\item{script}{(\code{character})\cr -file that contains R Code that can be read using \code{\link{read_script}}. -Preferred before \code{code} argument.} - -\item{vars}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{dataname}{(\code{character})\cr -Dataname to be mutated.} -} -\value{ -modified \code{x} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -} -\examples{ -library(scda) -library(magrittr) - -ADSL <- synthetic_cdisc_data("latest")$adsl - -ADSL_dataset <- dataset( - dataname = "ADSL", - x = ADSL, - label = "AdAM subject-level dataset", - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl" -) -ADSL_mutated <- ADSL_dataset \%>\% - mutate_dataset(code = "ADSL$new_variable <- 1") - -ADSL_mutated$get_raw_data()$new_variable[1] - -# Use an R script to mutate the data -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "ADSL <- ADSL \%>\% - dplyr::mutate(new_variable = new_variable * 2)" - ), - con = file_example -) - -ADSL_mutated <- ADSL_mutated \%>\% - mutate_dataset(script = file_example) - -ADSL_mutated$get_raw_data()$new_variable[1] - -ADSL_mutated <- ADSL_mutated \%>\% - mutate_dataset(code = read_script(file_example)) - -ADSL_mutated$get_raw_data()$new_variable[1] -} diff --git a/man/mutate_join_keys.Rd b/man/mutate_join_keys.Rd index ba5166d16..593706edd 100644 --- a/man/mutate_join_keys.Rd +++ b/man/mutate_join_keys.Rd @@ -3,14 +3,14 @@ \name{mutate_join_keys} \alias{mutate_join_keys} \alias{mutate_join_keys.JoinKeys} -\alias{mutate_join_keys.TealData} +\alias{mutate_join_keys.tdata} \title{Mutate \code{JoinKeys} with a new values} \usage{ mutate_join_keys(x, dataset_1, dataset_2, val) \method{mutate_join_keys}{JoinKeys}(x, dataset_1, dataset_2, val) -\method{mutate_join_keys}{TealData}(x, dataset_1, dataset_2, val) +\method{mutate_join_keys}{tdata}(x, dataset_1, dataset_2, val) } \arguments{ \item{x}{(\code{JoinKeys}) object to be modified} diff --git a/man/new_tdata.Rd b/man/new_tdata.Rd new file mode 100644 index 000000000..16a67306a --- /dev/null +++ b/man/new_tdata.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/tdata-constructors.r +\name{new_tdata} +\alias{new_tdata} +\alias{new_tdata,list,expression-method} +\alias{new_tdata,list,language-method} +\alias{new_tdata,list,character-method} +\title{Initialize \code{tdata} object} +\usage{ +new_tdata(env = new.env(), code = expression(), join_keys = join_keys()) + +\S4method{new_tdata}{list,expression}(env = new.env(), code = expression(), join_keys = join_keys()) + +\S4method{new_tdata}{list,language}(env = new.env(), code = expression(), join_keys = join_keys()) + +\S4method{new_tdata}{list,character}(env = new.env(), code = expression(), join_keys = join_keys()) +} +\arguments{ +\item{env}{(\code{list}) List of data.} + +\item{code}{(\code{character(1)} or \code{language}) code to evaluate. Accepts and stores comments also.} +} +\description{ +Initialize \code{tdata} object. +} +\examples{ +new_tdata(env = list(a = 1), code = quote(a <- 1)) +new_tdata(env = list(a = 1), code = parse(text = "a <- 1")) +new_tdatas(env = list(a = 1), code = "a <- 1") + +} diff --git a/man/python_code.Rd b/man/python_code.Rd deleted file mode 100644 index 75bae9cf0..000000000 --- a/man/python_code.Rd +++ /dev/null @@ -1,63 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CallablePythonCode.R -\name{python_code} -\alias{python_code} -\title{Python Code} -\usage{ -python_code(code = character(0), script = character(0)) -} -\arguments{ -\item{code}{(\code{character})\cr -Code to mutate the dataset. Must contain the \code{dataset$dataname}.} - -\item{script}{(\code{character})\cr -file that contains python Code that can be read using \code{reticulate::py_run_script}.} -} -\value{ -(\code{PythonCodeClass}) object containing python code -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Create a python code object directly from python code or a -script containing python code. -} -\details{ -Used to mutate dataset connector objects with python code. See -\code{\link{mutate_dataset}} or \code{\link{mutate_data}} for details. -} -\examples{ -\dontrun{ -library(scda) -library(reticulate) -library(magrittr) - -# mutate dataset object - -ADSL <- synthetic_cdisc_data("latest")$adsl - -x <- scda_cdisc_dataset_connector("ADSL", "adsl") - -x \%>\% mutate_dataset(python_code("import pandas as pd -r.ADSL = pd.DataFrame({'x': [1]})")) - -x$get_code() -x$pull() -x$get_raw_data() - -# mutate data object - -y <- 8 -tc <- cdisc_data( - scda_cdisc_dataset_connector("ADSL", "adsl"), - scda_cdisc_dataset_connector("ADLB", "adlb") -) - -tc \%>\% mutate_data(python_code("import pandas as pd -r.ADSL = pd.DataFrame({'STUDYID': [r.y], 'USUBJID': [r.y]})"), vars = list(y = y)) - - -load_datasets(tc) # submit all -ds <- tc$get_dataset("ADSL") -ds$get_raw_data() -} -} diff --git a/man/python_dataset_connector.Rd b/man/python_dataset_connector.Rd deleted file mode 100644 index ec8d34c37..000000000 --- a/man/python_dataset_connector.Rd +++ /dev/null @@ -1,184 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{python_dataset_connector} -\alias{python_dataset_connector} -\alias{python_cdisc_dataset_connector} -\title{\code{Python} \code{TealDatasetConnector}} -\usage{ -python_dataset_connector( - dataname, - file, - code, - object = dataname, - keys = character(0), - label = character(0), - mutate_code = character(0), - mutate_script = character(0), - vars = list(), - metadata = NULL -) - -python_cdisc_dataset_connector( - dataname, - file, - code, - object = dataname, - keys = get_cdisc_keys(dataname), - parent = if (identical(dataname, "ADSL")) character(0L) else "ADSL", - mutate_code = character(0), - mutate_script = character(0), - label = character(0), - vars = list(), - metadata = NULL -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{file}{(\code{character})\cr -Path to the file location containing the python script used to generate the object.} - -\item{code}{(\code{character})\cr -string containing the python code to be run using \code{reticulate}. Carefully consider -indentation to follow proper python syntax.} - -\item{object}{(\code{character})\cr -name of the object from the python script that is assigned to the dataset to be used.} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{mutate_code}{(\code{character})\cr -String containing the code used to mutate the object -after it is produced.} - -\item{mutate_script}{(\code{character})\cr -Alternatively to \code{mutate_code} - location of the file containing modification code. -Can't be used simultaneously with \code{mutate_script}.} - -\item{vars}{(named \code{list})) \cr -In case when this object code depends on other \code{TealDataset} object(s) or -other constant value, this/these object(s) should be included as named -element(s) of the list. For example if this object code needs \code{ADSL} -object we should specify \verb{vars = list(ADSL = )}. -It's recommended to include \code{TealDataset} or \code{TealDatasetConnector} objects to -the \code{vars} list to preserve reproducibility. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Create a \code{TealDatasetConnector} from \code{.py} file or through python code supplied directly. - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Create a \code{CDISCTealDatasetConnector} from \code{.py} file or through python code supplied directly. -} -\details{ -Note that in addition to the \code{reticulate} package, support for python requires an -existing python installation. By default, \code{reticulate} will attempt to use the -location \code{Sys.which("python")}, however the path to the python installation can be -supplied directly via \code{reticulate::use_python}. - -The \code{teal} API for delayed data requires the python code or script to return a -data.frame object. For this, the \code{pandas} package is required. This can be installed -using \code{reticulate::py_install("pandas")}. - -Please see the package documentation for more details. -} -\note{ -Raises an error when passed \code{code} and \code{file} are passed at the same time. - -When using \code{code}, keep in mind that when using \code{reticulate} with delayed data, python -functions do not have access to other objects in the \code{code} and must be self contained. -In the following example, the function \code{makedata()} doesn't have access to variable \code{x}: - -\preformatted{import pandas as pd - -x = 1 -def makedata(): - return pd.DataFrame({'x': [x, 2], 'y': [3, 4]}) - -data = makedata()} - -When using custom functions, the function environment must be entirely self contained: - -\preformatted{def makedata(): - import pandas as pd - x = 1 - return pd.DataFrame({'x': [x, 2], 'y': [3, 4]}) - -data = makedata() - } - -\strong{Additional \code{reticulate} considerations:} -\enumerate{ -\item Note that when using pull \code{vars}, \code{R} objects referenced in the python -code or script have to be prefixed with \code{r.}. -\item \code{reticulate} isn't able to convert \code{POSIXct} objects. Please take extra -care when working with \code{datetime} variables. -} - -Please read the official documentation for the \code{reticulate} package for additional -features and current limitations. -} -\examples{ -\dontrun{ -library(reticulate) - -# supply python code directly in R - -x <- python_dataset_connector( - "ADSL", - code = "import pandas as pd -data = pd.DataFrame({'STUDYID': [1, 2], 'USUBJID': [3, 4]})", - object = "data" -) - -x$pull() -x$get_raw_data() - -# supply an external python script - -python_file <- tempfile(fileext = ".py") -writeLines( - text = "import pandas as pd -data = pd.DataFrame({'STUDYID': [1, 2], 'USUBJID': [3, 4]})", - con = python_file -) - -x <- python_dataset_connector( - "ADSL", - file = python_file, - object = "data", -) - -x$pull() -x$get_raw_data() - -# supply pull `vars` from R - -y <- 8 -x <- python_dataset_connector( - "ADSL", - code = "import pandas as pd -data = pd.DataFrame({'STUDYID': [r.y], 'USUBJID': [r.y]})", - object = "data", - vars = list(y = y) -) - -x$pull() -x$get_raw_data() -} -} diff --git a/man/rds_dataset_connector.Rd b/man/rds_dataset_connector.Rd deleted file mode 100644 index 49f9752b1..000000000 --- a/man/rds_dataset_connector.Rd +++ /dev/null @@ -1,85 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{rds_dataset_connector} -\alias{rds_dataset_connector} -\alias{rds_cdisc_dataset_connector} -\title{\code{RDS} \code{TealDatasetConnector}} -\usage{ -rds_dataset_connector( - dataname, - file, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "rds", file = file), - ... -) - -rds_cdisc_dataset_connector( - dataname, - file, - keys = get_cdisc_keys(dataname), - parent = if (identical(dataname, "ADSL")) character(0L) else "ADSL", - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "rds", file = file), - ... -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{file}{(\code{character})\cr -path to (\code{.rds} or \code{.R}) that contains \code{data.frame} object or -code to \code{source}} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{code}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{...}{(\code{optional})\cr -additional arguments applied to \code{\link[base:readRDS]{base::readRDS()}} function} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create a \code{TealDatasetConnector} from \code{RDS} file. - -Create a \code{CDSICTealDatasetConnector} from \code{RDS} file with keys automatically -assigned by \code{dataname} -} -\examples{ -\dontrun{ -x <- rds_dataset_connector( - dataname = "ADSL", - file = "path/to/file.RDS" -) -x$get_code() -} -} diff --git a/man/relational_data_connector.Rd b/man/relational_data_connector.Rd deleted file mode 100644 index c865aa496..000000000 --- a/man/relational_data_connector.Rd +++ /dev/null @@ -1,96 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDataConnector.R -\name{relational_data_connector} -\alias{relational_data_connector} -\title{The constructor for \code{TealDataConnector} class.} -\usage{ -relational_data_connector(connection, connectors) -} -\arguments{ -\item{connection}{(\code{TealDataConnection})\cr -connection to data source} - -\item{connectors}{(\code{list} of \code{TealDatasetConnector} elements)\cr -list with dataset connectors} -} -\value{ -\code{TealDataConnector} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\examples{ - -library(scda) -adsl <- scda_cdisc_dataset_connector(dataname = "ADSL", "adsl") -adlb <- scda_cdisc_dataset_connector(dataname = "ADLB", "adlb") - -open_fun <- callable_function(library) -open_fun$set_args(list(package = "scda")) - -con <- data_connection(open_fun = open_fun) -con$set_open_server( - function(id, connection) { - moduleServer( - id = id, - module = function(input, output, session) { - connection$open(try = TRUE) - return(invisible(connection)) - } - ) - } -) - -x <- relational_data_connector(connection = con, connectors = list(adsl, adlb)) - -x$set_ui( - function(id, connection, connectors) { - ns <- NS(id) - tagList( - connection$get_open_ui(ns("open_connection")), - textInput(ns("name"), p("Choose", code("scda data version")), value = "latest"), - do.call( - what = "tagList", - args = lapply( - connectors, - function(connector) { - div( - connector$get_ui( - id = ns(connector$get_dataname()) - ), - br() - ) - } - ) - ) - ) - } -) - -x$set_server( - function(id, connection, connectors) { - moduleServer( - id = id, - module = function(input, output, session) { - # opens connection - connection$get_open_server()(id = "open_connection", connection = connection) - if (connection$is_opened()) { - for (connector in connectors) { - set_args(connector, args = list(archive_name = input$name)) - # pull each dataset - connector$get_server()(id = connector$get_dataname()) - if (connector$is_failed()) { - break - } - } - } - } - ) - } -) -\dontrun{ -x$launch() -x$get_datasets() -} - -} diff --git a/man/scda_dataset_connector.Rd b/man/scda_dataset_connector.Rd deleted file mode 100644 index fa04905b7..000000000 --- a/man/scda_dataset_connector.Rd +++ /dev/null @@ -1,92 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{scda_dataset_connector} -\alias{scda_dataset_connector} -\alias{scda_cdisc_dataset_connector} -\title{\code{scda} \code{TealDatasetConnector}} -\usage{ -scda_dataset_connector( - dataname, - scda_dataname = tolower(dataname), - scda_name = "latest", - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "scda", version = scda_name) -) - -scda_cdisc_dataset_connector( - dataname, - scda_dataname = tolower(dataname), - scda_name = "latest", - keys = get_cdisc_keys(dataname), - parent = if (identical(dataname, "ADSL")) character(0L) else "ADSL", - label = character(0), - code = character(0), - script = character(0), - metadata = list(type = "scda", version = scda_name) -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{scda_dataname}{(\code{character}) which \code{scda} dataset to use (e.g. \code{adsl}).} - -\item{scda_name}{(\code{character}) which version of \code{scda} data to take, default "latest".} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{code}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create a \code{TealDatasetConnector} for dataset in \code{scda} - -Create a \code{CDISCTealDatasetConnector} from \code{scda} data -} -\examples{ -library(scda) -x <- scda_dataset_connector( - dataname = "ADSL", scda_dataname = "adsl", -) -x$get_code() -load_dataset(x) -get_dataset(x) -get_dataset(x)$get_metadata() -x$get_raw_data() - -metadata_fun <- callable_function(function(a) list(type = a)) -metadata_fun$set_args(args = list(a = "scda")) -y <- scda_dataset_connector( - dataname = "ADSL", scda_dataname = "adsl", - metadata = metadata_fun -) -load_dataset(y) -get_dataset(y)$get_metadata() -} diff --git a/man/script_dataset_connector.Rd b/man/script_dataset_connector.Rd deleted file mode 100644 index 16df679dc..000000000 --- a/man/script_dataset_connector.Rd +++ /dev/null @@ -1,90 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/TealDatasetConnector_constructors.R -\name{script_dataset_connector} -\alias{script_dataset_connector} -\alias{script_cdisc_dataset_connector} -\title{Script \code{TealDatasetConnector}} -\usage{ -script_dataset_connector( - dataname, - file, - keys = character(0), - label = character(0), - code = character(0), - script = character(0), - metadata = NULL, - ... -) - -script_cdisc_dataset_connector( - dataname, - file, - keys = get_cdisc_keys(dataname), - parent = if (identical(dataname, "ADSL")) character(0L) else "ADSL", - label = character(0), - code = character(0), - script = character(0), - metadata = NULL, - ... -) -} -\arguments{ -\item{dataname}{(\code{character})\cr -A given name for the dataset it may not contain spaces} - -\item{file}{(\code{character})\cr -file location containing code to be evaluated in connector. Object obtained in the last -call from file will be returned to the connector - same as \code{source(file = file)$value}} - -\item{keys}{optional, (\code{character})\cr -vector of dataset primary keys column names} - -\item{label}{(\code{character})\cr -Label to describe the dataset.} - -\item{code}{(\code{character})\cr -A character string defining code to modify \code{raw_data} from this dataset. To modify -current dataset code should contain at least one assignment to object defined in \code{dataname} -argument. For example if \code{dataname = ADSL} example code should contain -\verb{ADSL <- }. Can't be used simultaneously with \code{script}} - -\item{script}{(\code{character})\cr -Alternatively to \code{code} - location of the file containing modification code. -Can't be used simultaneously with \code{script}.} - -\item{metadata}{(named \code{list}, \code{NULL} or \code{CallableFunction}) \cr -Field containing either the metadata about the dataset (each element of the list -should be atomic and length one) or a \code{CallableFuntion} to pull the metadata -from a connection. This should return a \code{list} or an object which can be -converted to a list with \code{as.list}.} - -\item{...}{Additional arguments applied to pull function. -In case when this object code depends on the \code{raw_data} from the other -\code{TealDataset}, \code{TealDatasetConnector} object(s) or other constant value, -this/these object(s) should be included. Please note that \code{vars} -are included to this object as local \code{vars} and they cannot be modified -within another dataset.} - -\item{parent}{(\code{character}, optional) parent dataset name} -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} - -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -} -\details{ -Create a \code{TealDatasetConnector} from \code{.R} file. - -Create a \code{CDISCTealDatasetConnector} from \code{script} file with keys assigned -automatically by \code{dataname}. -} -\examples{ -\dontrun{ -x <- script_dataset_connector( - dataname = "ADSL", - file = "path/to/script.R", - keys = get_cdisc_keys("ADSL") -) -x$get_code() -} -} diff --git a/man/set_args.Rd b/man/set_args.Rd deleted file mode 100644 index 54e69b558..000000000 --- a/man/set_args.Rd +++ /dev/null @@ -1,48 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/set_args.R -\name{set_args} -\alias{set_args} -\alias{set_args.CallableFunction} -\alias{set_args.CallableCode} -\alias{set_args.TealDatasetConnector} -\title{Set arguments of a \code{CallableFunction}} -\usage{ -set_args(x, args) - -\method{set_args}{CallableFunction}(x, args) - -\method{set_args}{CallableCode}(x, args) - -\method{set_args}{TealDatasetConnector}(x, args) -} -\arguments{ -\item{x}{\code{CallableFunction} or \code{TealDatasetConnector})} - -\item{args}{(\code{NULL} or named \code{list}) dynamic arguments to function} -} -\value{ -nothing -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Set arguments of a \code{CallableFunction} -} -\examples{ -## Using CallableFunction -library(scda) -f <- function(df) { - synthetic_cdisc_data("latest")[[df]] -} -fun <- callable_function(f) -set_args(fun, list(df = "adsl")) -## Using CallableCode -library(scda) -f <- function(df) { - synthetic_cdisc_data("latest")[[df]] -} -code <- callable_code("f()") -set_args(code, list(df = "adsl")) -## Using TealDatasetConnector -ds <- dataset_connector("x", pull_callable = callable_function(data.frame)) -set_args(ds, list(x = 1:5, y = letters[1:5])) -} diff --git a/man/set_keys.Rd b/man/set_keys.Rd deleted file mode 100644 index 2ea29ea94..000000000 --- a/man/set_keys.Rd +++ /dev/null @@ -1,68 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/get_keys.R -\name{set_keys} -\alias{set_keys} -\alias{set_keys.TealDataset} -\alias{set_keys.TealDatasetConnector} -\alias{set_keys.TealDataAbstract} -\title{Set dataset primary keys} -\usage{ -set_keys(x, ...) - -\method{set_keys}{TealDataset}(x, keys, ...) - -\method{set_keys}{TealDatasetConnector}(x, keys, ...) - -\method{set_keys}{TealDataAbstract}(x, dataname, keys, ...) -} -\arguments{ -\item{x}{an object of \code{TealDataset} or \code{TealDatasetConnector} class} - -\item{...}{not used, only for support of S3} - -\item{keys}{optional, (\code{character}) vector with primary keys} - -\item{dataname}{(\code{character}) name of dataset for which set the keys} -} -\value{ -(\code{character}) vector of column names -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Set dataset primary keys -} -\examples{ -# TealDataset -------- - -set_keys( - dataset( - "DF", - data.frame(ID = 1:10, x = runif(10)) - ), - keys = c("ID") -) -# TealDatasetConnector -------- - -pull_fun <- callable_function( - function() { - data.frame(ID = 1:10, x = runif(10)) - } -) -set_keys( - dataset_connector( - "DF", - pull_fun - ), - keys = c("ID") -) -# TealData -------- - -set_keys( - teal_data( - dataset("x", data.frame(x1 = 1:10, y1 = 11:20), keys = "x1"), - dataset("y", data.frame(x2 = 1:10, y2 = 11:20), keys = "x2") - ), - "x", - c("x1", "y1") -) -} diff --git a/man/teal_data_file.Rd b/man/teal_data_file.Rd deleted file mode 100644 index 98a29184c..000000000 --- a/man/teal_data_file.Rd +++ /dev/null @@ -1,43 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_data.R -\name{teal_data_file} -\alias{teal_data_file} -\title{Load \code{TealData} object from a file} -\usage{ -teal_data_file(path, code = get_code(path)) -} -\arguments{ -\item{path}{A (\code{connection}) or a (\code{character})\cr -string giving the pathname of the file or URL to read from. "" indicates the connection \code{stdin}.} - -\item{code}{(\code{character})\cr -reproducible code to re-create object} -} -\value{ -\code{TealData} object -} -\description{ -\ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#experimental}{\figure{lifecycle-experimental.svg}{options: alt='[Experimental]'}}}{\strong{[Experimental]}} -Please note that the script has to end with a call creating desired object. The error will be raised otherwise. -} -\examples{ -# simple example -file_example <- tempfile(fileext = ".R") -writeLines( - text = c( - "library(teal.data) - - x1 <- dataset(dataname = \"IRIS\", - x = iris, - code = \"IRIS <- iris\") - - x2 <- dataset(dataname = \"MTCARS\", - x = mtcars, - code = \"MTCARS <- mtcars\") - - teal_data(x1, x2)" - ), - con = file_example -) -teal_data_file(file_example, code = character(0)) -} diff --git a/man/to_relational_data.Rd b/man/to_relational_data.Rd deleted file mode 100644 index 5a874092d..000000000 --- a/man/to_relational_data.Rd +++ /dev/null @@ -1,34 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/to_relational_data.R -\name{to_relational_data} -\alias{to_relational_data} -\title{S3 generic for \code{to_relational_data} function.} -\usage{ -to_relational_data(data) -} -\arguments{ -\item{data}{\code{TealDataset}, \code{TealDatasetConnector}, \code{data.frame}, \code{MultiAssayExperiment}, \code{list} -or \code{function} returning a named list.} -} -\value{ -\code{TealData} object -} -\description{ -This function takes an object and converts into a \code{TealData} object, the primary data -object for use in teal applications. -} -\details{ -Passing a \code{TealData} into this function leaves the object unchanged. -} -\examples{ - -to_relational_data(head(iris)) -to_relational_data(dataset("IRIS", head(iris))) -to_relational_data(list(iris = head(iris), mtcars = head(mtcars))) - -d_connector <- dataset_connector("iris", callable_function(function() head(iris))) -d_connector$pull() -to_relational_data(d_connector) - -} -\keyword{internal} diff --git a/man/topological_sort.Rd b/man/topological_sort.Rd index dc2ae496c..96d09bb6b 100644 --- a/man/topological_sort.Rd +++ b/man/topological_sort.Rd @@ -1,5 +1,5 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/topological_sort.R +% Please edit documentation in R/utils-topological_sort.R \name{topological_sort} \alias{topological_sort} \title{Topological graph sort} diff --git a/man/update_join_keys_to_primary.Rd b/man/update_join_keys_to_primary.Rd deleted file mode 100644 index b6e977ce9..000000000 --- a/man/update_join_keys_to_primary.Rd +++ /dev/null @@ -1,17 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/teal_data.R -\name{update_join_keys_to_primary} -\alias{update_join_keys_to_primary} -\title{Add primary keys as join_keys to a dataset self} -\usage{ -update_join_keys_to_primary(data_objects, join_keys) -} -\arguments{ -\item{data_objects}{(\code{list}) of \code{TealDataset}, \code{TealDatasetConnector} or \code{TealDataConnector} objects} - -\item{join_keys}{(\code{JoinKeys}) object} -} -\description{ -Add primary keys as join_keys to a dataset self -} -\keyword{internal} diff --git a/man/username_password_module.Rd b/man/username_password_module.Rd new file mode 100644 index 000000000..b24a64eaf --- /dev/null +++ b/man/username_password_module.Rd @@ -0,0 +1,41 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/ddl-username_password_module.R +\name{username_password_module} +\alias{username_password_module} +\alias{username_password_server} +\alias{username_password_ui} +\alias{username_password_args} +\title{offline_args for username_password_module} +\usage{ +username_password_server(id, offline_args, code, postprocess_fun) + +username_password_ui(id) + +username_password_args() +} +\arguments{ +\item{id}{(\code{character}) \code{shiny} module id.} + +\item{offline_args}{(\code{list} named)\cr +arguments to be substituted in the \code{code}. These +argument are going to replace arguments set through +\code{ui} and \code{server}. Example use case is when app user +is asked to input a password and we'd like to skip this +input in the reproducible code. Typically users password +is substituted with \code{askpass::askpass()} call, so the +returned code is still executable but secure.} + +\item{code}{(\code{character})\cr +Code to be evaluated and returned to the \code{postprocess_fun}} + +\item{postprocess_fun}{(\verb{function(env, code)})\cr +Function to be run after code is run. This function suppose +has two arguments: +\itemize{ +\item \code{env} (\code{environment}) returned as a result of the code evaluation +\item code (\code{character}) \code{code} provided with resolved (substituted) args. +}} +} +\description{ +offline_args for username_password_module +} diff --git a/tests/testthat/data_connectors/adsl.R b/tests/testthat/data_connectors/adsl.R deleted file mode 100644 index dd6c141ed..000000000 --- a/tests/testthat/data_connectors/adsl.R +++ /dev/null @@ -1,7 +0,0 @@ -library(scda) - -ADSL <- synthetic_cdisc_data("latest")$adsl # nolint -ADSL$xxx <- "1" # nolint - -# instead of return -ADSL diff --git a/tests/testthat/data_connectors/table.csv b/tests/testthat/data_connectors/table.csv deleted file mode 100644 index 57f9426d6..000000000 --- a/tests/testthat/data_connectors/table.csv +++ /dev/null @@ -1,6 +0,0 @@ -"Sepal.Length" "Sepal.Width" "Petal.Length" "Petal.Width" "Species" -"1" 5.1 3.5 1.4 0.2 "setosa" -"2" 4.9 3 1.4 0.2 "setosa" -"3" 4.7 3.2 1.3 0.2 "setosa" -"4" 4.6 3.1 1.5 0.2 "setosa" -"5" 5 3.6 1.4 0.2 "setosa" diff --git a/tests/testthat/data_connectors/table.rds b/tests/testthat/data_connectors/table.rds deleted file mode 100644 index ed64d978d..000000000 Binary files a/tests/testthat/data_connectors/table.rds and /dev/null differ diff --git a/tests/testthat/test-CDISCTealDataConnector.R b/tests/testthat/test-CDISCTealDataConnector.R deleted file mode 100644 index 8d23e5fd7..000000000 --- a/tests/testthat/test-CDISCTealDataConnector.R +++ /dev/null @@ -1,164 +0,0 @@ -adsl_cf <- CallableFunction$new(function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"))))) -adae_cf <- CallableFunction$new(function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE"))))) -adsl <- CDISCTealDatasetConnector$new("ADSL", adsl_cf, keys = get_cdisc_keys("ADSL"), parent = character(0)) -adae <- CDISCTealDatasetConnector$new("ADAE", adae_cf, keys = get_cdisc_keys("ADAE"), parent = "ADSL") - -testthat::test_that("get_code returns the correct code for two CDISCTealDatasetConnector objects", { - data <- CDISCTealDataConnector$new( - connection = TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")), - connectors = list(adsl, adae) - ) - - items <- data$get_items() - testthat::expect_true(inherits(data, "TealDataConnector")) - testthat::expect_true(all(vapply(items, inherits, logical(1), "TealDatasetConnector"))) - - testthat::expect_equal( - items$ADSL$get_code(), - "ADSL <- (function() as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\")))))()" - ) - testthat::expect_equal( - items$ADAE$get_code(), - "ADAE <- (function() as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADAE\")))))()" - ) - data$pull() - - testthat::expect_equal( - data$get_code("ADSL"), - paste( - "(function() \"open function\")()", - "ADSL <- (function() as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\")))))()", - sep = "\n" - ) - ) - testthat::expect_equal( - data$get_code("ADAE"), - paste( - "(function() \"open function\")()", - "ADAE <- (function() as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADAE\")))))()", - sep = "\n" - ) - ) - testthat::expect_equal( - data$get_code(), - paste( - "(function() \"open function\")()", - "ADSL <- (function() as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\")))))()", - "ADAE <- (function() as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADAE\")))))()", - sep = "\n" - ) - ) -}) - - -# TealDataConnector with custom UI and server ---- -testthat::test_that("TealDataConnector with custom UI and server", { - adsl_cf <- CallableFunction$new(function(test) { - test - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - }) - adsl <- CDISCTealDatasetConnector$new("ADSL", adsl_cf, keys = get_cdisc_keys("ADSL"), parent = character(0)) - con <- TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")) - cdisc_data_connector <- CDISCTealDataConnector$new(connection = con, connectors = list(adsl)) - - items <- cdisc_data_connector$get_items() - testthat::expect_true(inherits(cdisc_data_connector, "TealDataConnector")) - testthat::expect_true(all(vapply(items, inherits, logical(1), "TealDatasetConnector"))) - - testthat::expect_equal( - items$ADSL$get_pull_callable()$get_call(), - paste( - "(function(test) {", - " test", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_error( - cdisc_data_connector$get_ui("main-app"), - "No UI set yet" - ) - - cdisc_data_connector$set_ui(function(id, ...) { - ns <- NS(id) - tagList( - numericInput(ns("test"), "Choose test", min = 1, max = 100, value = 1) - ) - }) - - testthat::expect_equal( - as.character(cdisc_data_connector$get_ui("main-app")), - as.character( - tags$div( - h3("Data Connector for:", list(code("ADSL"))), - tags$div( - id = "main-app-data_input", - numericInput("main-app-data_input-test", "Choose test", min = 1, max = 100, value = 1) - ) - ) - ) - ) - - cdisc_data_connector$set_server(function(id, connectors, connection) { - raw_datasets <- lapply(connectors, function(connector) { - set_args(connector, args(test = input$test)) - connector$pull(try = TRUE) - - connector$get_raw_data() - }) - }) - set_server <- cdisc_data_connector$get_server() - testthat::expect_false(is.null(set_server)) - - testthat::expect_error(get_datasets(cdisc_data_connector), regexp = "Not all datasets have been pulled yet") - cdisc_data_connector$set_pull_args(args = list(test = 7)) - cdisc_data_connector$pull() - testthat::expect_true(is_pulled(cdisc_data_connector)) - - datasets <- get_datasets(cdisc_data_connector) - testthat::expect_true(all(vapply(datasets, inherits, logical(1), "TealDataset"))) - - testthat::expect_equal( - cdisc_data_connector$get_code("ADSL"), - paste( - "(function() \"open function\")()", - "ADSL <- (function(test) {", - " test", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})(test = 7)", - sep = "\n" - ) - ) - testthat::expect_equal( - cdisc_data_connector$get_code(), - paste( - "(function() \"open function\")()", - "ADSL <- (function(test) {", - " test", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})(test = 7)", - sep = "\n" - ) - ) -}) - -testthat::test_that("cdisc_data_connector returns a CDISCTealDataConnector object on basic input", { - data <- cdisc_data_connector( - connection = TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")), - connectors = list(adsl, adae) - ) - testthat::expect_true(inherits(data, c("CDISCTealDataConnector", "TealDataConnector", "TealDataAbstract", "R6"))) -}) - -testthat::test_that("cdisc_data_connector validates the 'connection' and 'connectors' arguments", { - testthat::expect_error(cdisc_data_connector( - connection = 1, - connectors = list(adsl, adae) - )) - testthat::expect_error(cdisc_data_connector( - connection = TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")), - connectors = "a" - )) -}) diff --git a/tests/testthat/test-CDISCTealDataset.R b/tests/testthat/test-CDISCTealDataset.R deleted file mode 100644 index 715b61dda..000000000 --- a/tests/testthat/test-CDISCTealDataset.R +++ /dev/null @@ -1,122 +0,0 @@ -## CDISCTealDataset ==== -testthat::test_that("CDISCTealDataset basics", { - x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = TRUE) - formatters::var_labels(x) <- c("X", "Y") - - testthat::expect_error( - teal.data:::CDISCTealDataset$new(dataname = "abc", x = x) - ) - - testthat::expect_silent({ - test_ds <- CDISCTealDataset$new( - dataname = "testds", - x = x, - keys = "x", - parent = "testds2" - ) - }) - - testthat::expect_equal( - test_ds$get_parent(), - "testds2" - ) - - testthat::expect_silent(test_ds$set_parent("testds3")) - testthat::expect_equal( - test_ds$get_parent(), - "testds3" - ) -}) - -testthat::test_that("CDISCTealDataset print method returns correct class name and content", { - x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = TRUE) - test_ds <- CDISCTealDataset$new( - dataname = "testds", - x = x, - keys = "x", - parent = "testds2" - ) - testthat::expect_identical( - capture.output(print(test_ds)), - c( - "A CDISCTealDataset object containing the following data.frame (2 rows and 2 columns):", - " x y", - "1 1 a", - "2 2 b" - ) - ) -}) - -testthat::test_that("data returns the data passed in the constructor", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- CDISCTealDataset$new("ADSL", adsl_raw, parent = character(0), keys = get_cdisc_keys("ADSL")) - - testthat::expect_identical(adsl_raw, adsl$data) -}) - -testthat::test_that("get_dataname returns the dataname passed to the constructor", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- CDISCTealDataset$new("ADSL", adsl_raw, parent = character(0), keys = get_cdisc_keys("ADSL")) - - testthat::expect_identical("ADSL", adsl$get_dataname()) -}) - -testthat::test_that("Case 1::CDISCTealDataset$get_code() does not return duplicated code when - CDISCTealDataset$mutate method is called", { - iris_dataset <- CDISCTealDataset$new("iris", head(iris), code = "head(iris)", parent = character(0), keys = c("test")) - mtcars_dataset <- CDISCTealDatasetConnector$new( - "mtcars", - callable_function(function() head(mtcars)), - parent = character(0), - keys = c("test") - ) - mtcars_dataset$pull() - mtcars_dataset$mutate("'mutating connector'") - - iris_dataset$mutate("'mutating dataset'", vars = list(mtcars_dataset = mtcars_dataset)) - testthat::expect_equal( - iris_dataset$get_code(), - paste( - "mtcars <- (function() head(mtcars))()", - "\"mutating connector\"", - "mtcars_dataset <- mtcars", - "head(iris)", - "\"mutating dataset\"", - sep = "\n" - ) - ) -}) - -testthat::test_that("Case 2::CDISCTealDataset$get_code() does not return duplicated code when - CDISCTealDataset$mutate method is called", { - adsl_d <- cdisc_dataset("ADSL", head(iris)) - adsl_d %>% - mutate_dataset("ADSL$a <- x", vars = list(x = 1)) %>% - mutate_dataset("ADSL$b <- y", vars = list(y = 2)) - - adae_d <- code_cdisc_dataset_connector("ADAE", "head(mtcars)") - adae_d %>% mutate_dataset("ADAE$a <- x", vars = list(x = 1)) - adae_d %>% mutate_dataset("ADAE$a <- ADAE$a*2") - adae_d %>% - load_dataset() %>% - mutate_dataset("ADAE$a <- ADAE$a*2") - - adsl_d %>% mutate_dataset("ADSL$c <- z", vars = list(z = 3)) - adsl_d %>% mutate_dataset("ADSL$d <- ADAE$a[[1]]", vars = list(ADAE = adae_d)) - testthat::expect_equal( - adsl_d$get_code() %>% pretty_code_string(), - c( - "x <- 1", - "y <- 2", - "z <- 3", - "ADAE <- head(mtcars)", - "ADAE$a <- x", - "ADAE$a <- ADAE$a * 2", - "ADAE$a <- ADAE$a * 2", - "ADSL$a <- x", - "ADSL$b <- y", - "ADSL$c <- z", - "ADSL$d <- ADAE$a[[1]]" - ) - ) -}) diff --git a/tests/testthat/test-CDISCTealDatasetConnector.R b/tests/testthat/test-CDISCTealDatasetConnector.R deleted file mode 100644 index 74f38f211..000000000 --- a/tests/testthat/test-CDISCTealDatasetConnector.R +++ /dev/null @@ -1,65 +0,0 @@ -library(scda) - -# Single scda dataset connector ---- -testthat::test_that("Single scda dataset connector", { - # create object - adsl <- scda_cdisc_dataset_connector("ADSL", "adsl") - default_ui <- adsl$get_ui("main-app") - adsl$set_ui_input(function(ns) { - list(textInput(inputId = ns("name"), label = "scda name", value = "latest")) - }) - set_ui <- adsl$get_ui("main-app") - testthat::expect_false(isTRUE(all.equal(default_ui, set_ui))) - - # check UI - testthat::expect_equal( - as.character(set_ui), - as.character( - tags$div( - tags$div( - id = "main-app-inputs", - h4("TealDataset Connector for ", code("ADSL")), - textInput(inputId = "main-app-name", label = "scda name", value = "latest") - ) - ) - ) - ) - - testthat::expect_error(adsl$get_raw_data(), regexp = "'ADSL' has not been pulled yet") - adsl$pull() - - testthat::expect_s3_class(adsl$get_raw_data(), "data.frame") - - # check reproducible code - testthat::expect_equal( - adsl$get_code(), - 'ADSL <- scda::synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest")' - ) -}) - -testthat::test_that("TealDatasetConnector$print prints out expected output of class and content", { - fun <- CallableFunction$new(function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"))))) - adsl <- cdisc_dataset_connector( - dataname = "ADSL", - pull_callable = fun, - keys = get_cdisc_keys("ADSL") - ) - - testthat::expect_identical( - capture.output(print(adsl)), - c( - "A CDISCTealDatasetConnector object, named ADSL, containing a TealDataset object that has not been loaded/pulled" - ) - ) - - adsl$pull() - testthat::expect_identical( - capture.output(print(adsl)), - c( - "A CDISCTealDatasetConnector object, named ADSL, containing a TealDataset object that has been loaded/pulled:", - "A CDISCTealDataset object containing the following data.frame (1 rows and 2 columns):", - " STUDYID USUBJID", - "1 STUDYID USUBJID" - ) - ) -}) diff --git a/tests/testthat/test-CallableCode.R b/tests/testthat/test-CallableCode.R deleted file mode 100644 index 38f0de86a..000000000 --- a/tests/testthat/test-CallableCode.R +++ /dev/null @@ -1,41 +0,0 @@ -testthat::test_that("Objects can be generated from the code", { - y_code <- callable_code("7") - testthat::expect_equal(y_code$get_call(), c("7")) - testthat::expect_identical(y_code$run(), 7) - - a_code <- callable_code("library(dplyr); starwars") - testthat::expect_s3_class(a_code$run(), "data.frame") -}) - -testthat::test_that("CallableCode can use objects from namespaces other than global", { - # direct usage of function from package - y_code <- callable_code("datasets::iris") - expect_equal(y_code$get_call(), c("datasets::iris")) - expect_identical(y_code$run(), datasets::iris) -}) - -testthat::test_that("get_call transforms double new lines into one new line", { - y2_code <- callable_code("13\n\n7") - testthat::expect_equal(y2_code$get_call(), c("13\n7")) - testthat::expect_identical(y2_code$run(), 7) -}) - -testthat::test_that("callable_code throws an error when supplied code is not valid", { - testthat::expect_error(callable_code("'"), "Code supplied is not valid") - testthat::expect_error(callable_code(""), "Code supplied is not valid") - # double ;; - testthat::expect_error( - callable_code("library(scda);; ADSL <- synthetic_cdisc_data(\"latest\")$adsl\nADSL;"), - "Code supplied is not valid" - ) - # we have to use newline or ; to separate the code lines - testthat::expect_error( - callable_code("library(scda) ADSL <- synthetic_cdisc_data(\"latest\")$adsl\nADSL"), - "Code supplied is not valid" - ) -}) - -testthat::test_that("run throws an error when an object referenced in the code is not found", { - x_code <- callable_code("ADSL$new <- 1; ADSL") - testthat::expect_error(x_code$run(), "object 'ADSL' not found") -}) diff --git a/tests/testthat/test-CallableFunction.R b/tests/testthat/test-CallableFunction.R deleted file mode 100644 index d6074f59e..000000000 --- a/tests/testthat/test-CallableFunction.R +++ /dev/null @@ -1,356 +0,0 @@ -testthat::test_that("Function found", { - testthat::expect_silent( - cfun <- callable_function(fun = data.frame) - ) - - testthat::expect_identical( - cfun$get_call(), - "data.frame()" - ) - - testthat::expect_silent( - cfun2 <- callable_function(fun = base::data.frame) - ) - - testthat::expect_identical( - cfun2$get_call(), - "data.frame()" - ) - - custom_fun <- function() { - 1L - } - testthat::expect_silent( - cfun3 <- callable_function( - fun = custom_fun - ) - ) - - testthat::expect_identical( - cfun3$get_call(), - "(function() {\n 1L\n})()" - ) - - testthat::expect_identical( - cfun3$run(), - 1L - ) - - testthat::expect_silent( - cfun4 <- callable_function( - function() { - library("MultiAssayExperiment") - data("miniACC") - return(miniACC) - } - ) - ) - - testthat::expect_identical( - cfun4$get_call(), - "(function() {\n library(\"MultiAssayExperiment\")\n data(\"miniACC\")\n return(miniACC)\n})()" - ) - - fun5 <- mean - expect_silent( - cfun5 <- callable_function(fun5) - ) -}) - -testthat::test_that("CallableFunction returns the correct name if passed a base function directly", { - testthat::expect_equal(callable_function(print)$get_call(), "print()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed an anonymous function", { - testthat::expect_equal(callable_function(function() "test")$get_call(), "(function() \"test\")()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed a name of a base function", { - testthat::expect_equal(callable_function("print")$get_call(), "print()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed a generic from a namespace", { - testthat::expect_equal(callable_function(utils::head)$get_call(), "utils::head()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed a prefixed name of a function", { - testthat::expect_equal(callable_function("base::print")$get_call(), "base::print()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed a namespace function indirectly", { - x <- print - testthat::expect_equal(callable_function(x)$get_call(), "print()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed a function from global env indirectly", { - x <- function() "test" - testthat::expect_equal(callable_function(x)$get_call(), "(function() \"test\")()") -}) - -testthat::test_that("CallableFunction returns the correct name if passed a function name indirectly", { - x <- "print" - testthat::expect_equal(callable_function(x)$get_call(), "print()") -}) - -testthat::test_that( - "CallableFunction throws an error if passed a namespace function via a binding in the parent frame", - code = { - x <- print - testthat::expect_error(callable_function("x")$get_call(), "object 'x' of mode 'function' was not found") - } -) - -testthat::test_that("CallableFunction returns the correct name if passed a Primitive directly", { - testthat::expect_equal(callable_function(.Primitive("+"))$get_call(), ".Primitive(\"+\")()") -}) - -testthat::test_that("CallableFunction throws an error if passed a Primitive by character", { - testthat::expect_error(callable_function(".Primitive('+')")$get_call()) -}) - -testthat::test_that("CallableFunction throws an error if passed a prefixed object (not a function)", { - testthat::expect_error( - callable_function("datasets::iris")$get_call(), - regexp = "object 'datasets::iris' of mode 'function' was not found" - ) -}) - -testthat::test_that("Test inputs", { - x_fun <- callable_function("mean") - x_fun$set_args(list(x = c(1.0, 2.0, NA_real_), na.rm = TRUE)) - - testthat::expect_identical( - x_fun$get_call(), - "mean(x = c(1, 2, NA), na.rm = TRUE)" - ) - - fun <- as.symbol("mean") - y_fun <- callable_function(fun) - y_fun$set_args(list(x = c(1.0, 2.0, NA_real_), na.rm = TRUE)) - - testthat::expect_identical( - y_fun$get_call(), - "mean(x = c(1, 2, NA), na.rm = TRUE)" - ) - - z_fun <- callable_function(base::mean) - z_fun$set_args(list(x = c(1.0, 2.0, NA_real_), na.rm = TRUE)) - - testthat::expect_identical( - z_fun$get_call(), - "mean(x = c(1, 2, NA), na.rm = TRUE)" - ) -}) - -testthat::test_that("Test callable", { - x_fun <- callable_function(base::mean) - x_fun$set_args(list(x = c(1.0, 2.0, NA_real_), na.rm = TRUE)) - - testthat::expect_identical( - x_fun$get_call(), - "mean(x = c(1, 2, NA), na.rm = TRUE)" - ) - - testthat::expect_identical( - x_fun$get_args(), - list( - x = c(1.0, 2.0, NA_real_), - na.rm = TRUE - ) - ) - - # get_call doesn't change args persistently - testthat::expect_false( - identical( - x_fun$get_call(), - x_fun$get_call(args = list(x = c(1.0, 2.0), na.rm = TRUE)) - ) - ) - - # args are still as in the beginning - testthat::expect_identical( - x_fun$get_args(), - list( - x = c(1.0, 2.0, NA_real_), - na.rm = TRUE - ) - ) - - testthat::expect_identical( - x_fun$run(), - mean(c(1.0, 2.0, NA_real_), na.rm = TRUE) - ) - - # run doesn't change args persistently - args <- list(na.rm = FALSE) - testthat::expect_false( - identical( - x_fun$run(), - x_fun$run(args = args) - ) - ) - - testthat::expect_false( - identical( - x_fun$.__enclos_env__$private$args, - args - ) - ) - - # args can be changed persistently by set_arg_value() - x_fun$set_arg_value(name = "na.rm", value = FALSE) - testthat::expect_identical( - x_fun$get_call(), - "mean(x = c(1, 2, NA), na.rm = FALSE)" - ) - - # args can be changed/added persistently by set_args() - x_fun$set_args(list(na.rm = TRUE, trim = 0.3)) - - testthat::expect_identical( - x_fun$get_call(), - "mean(x = c(1, 2, NA), na.rm = TRUE, trim = 0.3)" - ) - - - # try - testthat::expect_identical( - x_fun$run(try = TRUE), - x_fun$run(try = FALSE) - ) - - testthat::expect_identical( - x_fun$run(return = FALSE), - NULL - ) - - # cleaning args - x_fun$set_args(args = NULL) - testthat::expect_null(x_fun$get_args()) -}) - -testthat::test_that("test callable errors", { - x <- 1 - - testthat::expect_error( - callable_function(x), - "CallableFunction can be specified as character, symbol, call or function" - ) - - testthat::expect_error( - callable_function("x"), - "object 'x' of mode 'function' was not found" - ) - - testthat::expect_error( - callable_function(garbageIn), - "not found" - ) - - testthat::expect_error( - callable_function("garbageIn"), - "object 'garbageIn' of mode 'function' was not found" - ) - - testthat::expect_error( - callable_function(), - "A valid function name must be provided." - ) - - - testthat::expect_silent(x_fun <- callable_function(mean)) - - - # mean accepts extra arguments - testthat::expect_silent( - x_fun$set_args(list(y = 2, x = 1, na.rm = TRUE)) - ) - testthat::expect_identical( - x_fun$run(), - mean(y = 2, x = 1, na.rm = TRUE) - ) - - testthat::expect_equal( - object = { - x <- callable_function(base::all.equal) - x$set_args(list(target = c("abc"), current = c("abc"))) - x$run() - }, - TRUE - ) - - - x_fun <- callable_function(abs) - testthat::expect_silent( - x_fun$set_args(list(y = 2, x = 1, na.rm = TRUE)) - ) - testthat::expect_error( - x_fun$run(), - "3 arguments passed to" - ) -}) - -testthat::test_that("is failed", { - fun <- callable_function(sqrt) - testthat::expect_error( - fun$run(args = list(x = "")), - "non-numeric argument to mathematical function" - ) - testthat::expect_output( - testthat::expect_s3_class( - fun$run(args = list(x = ""), try = TRUE), - "error" - ) - ) - testthat::expect_true(fun$is_failed()) - testthat::expect_identical( - fun$get_error_message(), - "non-numeric argument to mathematical function" - ) - - testthat::expect_silent(fun$run(args = list(x = 1.5))) - testthat::expect_false(fun$is_failed()) - testthat::expect_identical( - fun$get_error_message(), - character(0) - ) -}) - -testthat::test_that("test cloning", { - fun <- callable_function(stats::sd) - fun$set_args(list(x = call(":", as.name("x1"), as.name("x2")))) - fun$assign_to_env(x = "x1", value = 0) - fun$assign_to_env(x = "x2", value = 10) - testthat::expect_identical( - fun$get_call(), - "stats::sd(x = x1:x2)" - ) - - testthat::expect_identical( - ls(envir = fun$.__enclos_env__$private$env), - c("x1", "x2") - ) - - testthat::expect_identical( - fun$run(), - stats::sd(0:10) - ) - - fun_cloned <- fun$clone() - testthat::expect_identical( - fun$.__enclos_env__$private$env, - fun_cloned$.__enclos_env__$private$env - ) - - fun_cloned_deep <- fun$clone(deep = TRUE) - testthat::expect_false( - identical( - fun$.__enclos_env__$private$env, - fun_cloned_deep$.__enclos_env__$private$env - ) - ) -}) - -testthat::test_that("get_binding_name throws if the function could not be found in the environment", { - testthat::expect_error(get_binding_name("test", emptyenv()), regexp = "Object not found in the environment") -}) diff --git a/tests/testthat/test-MAETealDataset.R b/tests/testthat/test-MAETealDataset.R deleted file mode 100644 index aa9c14558..000000000 --- a/tests/testthat/test-MAETealDataset.R +++ /dev/null @@ -1,204 +0,0 @@ -testthat::test_that("MAETealDataset constructors do not raise exceptions", { - utils::data(miniACC, package = "MultiAssayExperiment") - testthat::expect_silent(MAETealDataset$new("testMAE", miniACC)) - code_class <- CodeClass$new( - "utils::data(miniACC, package = \"MultiAssayExperiment\") - testMAE <- miniACC", - dataname = "testMAE" - ) - testthat::expect_silent( - MAETealDataset$new(dataname = "testMAE", x = miniACC, code = code_class) - ) -}) - -testthat::test_that("MAETealDataset$recreate updates the class fields", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- MAETealDataset$new("testMAE", miniACC) - - suppressWarnings(new_data <- miniACC[, , "RNASeq2GeneNorm"]) # warning only on rocker 4.1 - new_name <- "new_name" - new_label <- "new_label" - new_code <- "new_code" - new_keys <- c("new_key") - new_vars <- list(new_var = "new_var") - - testthat::expect_silent(mae$recreate( - dataname = new_name, - x = new_data, - keys = new_keys, - code = new_code, - vars = new_vars - )) - testthat::expect_equal(mae$get_dataname(), new_name) - testthat::expect_equal(mae$get_raw_data(), new_data) - testthat::expect_equal(mae$get_keys(), new_keys) - testthat::expect_equal(mae$get_code(), "new_var <- \"new_var\"\nnew_code") -}) - -testthat::test_that("MAETealDataset getters and setters", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- MAETealDataset$new( - dataname = "miniACC", - x = miniACC, - metadata = list(A = 5, B = TRUE, C = "foo") - ) - - testthat::expect_equal(mae$get_dataname(), "miniACC") - testthat::expect_equal(mae$get_datanames(), mae$get_dataname()) - testthat::expect_equal(mae$get_metadata(), list(A = 5, B = TRUE, C = "foo")) - testthat::expect_equal(mae$get_raw_data(), miniACC) - - new_label <- "new_label" - testthat::expect_silent(mae$set_dataset_label(new_label)) - testthat::expect_equal(mae$get_dataset_label(), new_label) - - new_keys <- c("new_key") - testthat::expect_silent(mae$set_keys(new_keys)) - testthat::expect_equal(mae$get_keys(), new_keys) - - new_code <- "new_code" - testthat::expect_silent(mae$set_code(new_code)) - testthat::expect_equal(mae$get_code(), new_code) - - new_vars <- list(new_var = "new_var") - testthat::expect_silent(mae$set_vars(new_vars)) -}) - -testthat::test_that("MAETealDataset$is_pulled returns true", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- MAETealDataset$new(dataname = "miniACC", x = miniACC) - testthat::expect_true(mae$is_pulled()) -}) - -testthat::test_that("MAETealDataset$check returns TRUE when constructed with the correct code", { - exprss1 <- matrix( - seq(from = 1, by = 0.1, length.out = 16), - ncol = 4, - dimnames = list(sprintf("ENST00000%i", seq.int(1, 4)), c("Jack", "Jill", "Bob", "Bobby")) - ) - exprss2 <- matrix( - seq(from = 5, by = 0.1, length.out = 12), - ncol = 3, - dimnames = list(sprintf("ENST00000%i", seq.int(1, 4)), c("Jack", "Jane", "Bob")) - ) - double_exp <- list("methyl 2k" = exprss1, "methyl 3k" = exprss2) - simple_mae <- MultiAssayExperiment::MultiAssayExperiment(experiments = double_exp) - - mae_dataset <- MAETealDataset$new( - dataname = "simple_mae", - x = simple_mae, - code = "exprss1 <- matrix( - seq(from = 1, by = 0.1, length.out = 16), - ncol = 4, - dimnames = list(sprintf('ENST00000%i', seq.int(1, 4)), c('Jack', 'Jill', 'Bob', 'Bobby')) - ) - exprss2 <- matrix( - seq(from = 5, by = 0.1, length.out = 12), ncol = 3, - dimnames = list(sprintf('ENST00000%i', seq.int(1, 4)), c('Jack', 'Jane', 'Bob')) - ) - doubleExp <- list('methyl 2k' = exprss1, 'methyl 3k' = exprss2) - simple_mae <- MultiAssayExperiment::MultiAssayExperiment(experiments=doubleExp)" - ) - testthat::expect_true(mae_dataset$check()) -}) - -testthat::test_that("FALSE returned when executing MAETealDataset$check and code is not correct", { - exprss1 <- matrix( - seq(from = 1, by = 0.1, length.out = 16), - ncol = 4, - dimnames = list(sprintf("ENST00000%i", seq.int(1, 4)), c("Jack", "Jill", "Bob", "Bobby")) - ) - exprss2 <- matrix( - seq(from = 5, by = 0.1, length.out = 12), - ncol = 3, - dimnames = list(sprintf("ENST00000%i", seq.int(1, 4)), c("Jack", "Jane", "Bob")) - ) - double_exp <- list("methyl 2k" = exprss1, "methyl 3k" = exprss2) - simple_mae <- MultiAssayExperiment::MultiAssayExperiment(experiments = double_exp) - - mae_dataset <- MAETealDataset$new( - dataname = "simple_mae", - x = simple_mae, - code = "exprss1 <- matrix( - seq(from = 1, by = 0.1, length.out = 16), - ncol = 4, - dimnames = list(sprintf('ENST00000%i', seq.int(1, 4)), c('Jack', 'Jill', 'Bob', 'Bobby')) - ) - exprss2 <- matrix( - seq(from = 5, by = 0.1, length.out = 12), ncol = 3, - dimnames = list(sprintf('ENST00000%i', seq.int(1, 4)), c('Jack', 'Jane', 'Bob')) - ) - doubleExp <- list('methyl 1k' = exprss1, 'methyl 3k' = exprss2) - simple_mae <- MultiAssayExperiment::MultiAssayExperiment(experiments=doubleExp)" - ) - testthat::expect_false(mae_dataset$check()) -}) - -testthat::test_that("Error raised when executing MAETealDataset$check and code is empty", { - exprss1 <- matrix( - seq(from = 1, by = 0.1, length.out = 16), - ncol = 4, - dimnames = list(sprintf("ENST00000%i", seq.int(1, 4)), c("Jack", "Jill", "Bob", "Bobby")) - ) - exprss2 <- matrix( - seq(from = 5, by = 0.1, length.out = 12), - ncol = 3, - dimnames = list(sprintf("ENST00000%i", seq.int(1, 4)), c("Jack", "Jane", "Bob")) - ) - double_exp <- list("methyl 2k" = exprss1, "methyl 3k" = exprss2) - simple_mae <- MultiAssayExperiment::MultiAssayExperiment(experiments = double_exp) - - mae_dataset <- MAETealDataset$new(dataname = "simple_mae", x = simple_mae, code = "") - testthat::expect_error( - mae_dataset$check(), - regexp = "Cannot check preprocessing code of" - ) -}) - -testthat::test_that("MAETealDataset$check_keys doesn't throw if constructed with correct keys", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- MAETealDataset$new(dataname = "miniACC", x = miniACC, keys = "patientID") - testthat::expect_silent(mae$check_keys()) -}) - -testthat::test_that("MAETealDataset$check_keys throws if constructed with keys not present in colData", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- MAETealDataset$new(dataname = "miniACC", x = miniACC, keys = "wrong keys") - testthat::expect_error( - mae$check_keys(), - regexp = "do not exist in the data" - ) -}) - -testthat::test_that("Error raised executing MAETealDataset$check_keys and duplicate rows found in key columns", { - array_data <- matrix( - seq(101, 108), - ncol = 4, - dimnames = list(c("probe1", "probe2"), c("sample1", "sample2", "sample3", "sample4")) - ) - col_data <- data.frame( - sample_id = c("sample1", "sample2", "sample3", "sample3"), - row.names = c("sample1", "sample2", "sample3", "sample4") - ) - test_mae <- MultiAssayExperiment::MultiAssayExperiment( - experiments = list("test_exp1" = array_data), - colData = col_data - ) - mae_dataset <- MAETealDataset$new(dataname = "test_mae", x = test_mae, keys = "sample_id") - testthat::expect_error( - mae_dataset$check_keys(), - regexp = "Duplicate primary key values found in the dataset 'test_mae'" - ) -}) - -testthat::test_that("dataset() does not throw when passed a MultiAssayExperiment object", { - utils::data(miniACC, package = "MultiAssayExperiment") - testthat::expect_error(dataset("mae", miniACC), NA) -}) - -testthat::test_that("dataset() constructor returns the same as MAETealDataset$new()", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae1 <- dataset("mae", miniACC) - mae2 <- MAETealDataset$new("mae", miniACC) - testthat::expect_equal(mae1, mae2) -}) diff --git a/tests/testthat/test-TealData.R b/tests/testthat/test-TealData.R deleted file mode 100644 index d5ee39e7a..000000000 --- a/tests/testthat/test-TealData.R +++ /dev/null @@ -1,639 +0,0 @@ -testthat::test_that("TealData$new throws if data is not valid", { - testthat::expect_error( - TealData$new("mtcars"), - "All elements should be of TealDataset\\(Connector\\) or TealDataConnector class" - ) - - testthat::expect_error( - TealData$new(mtcars), - "All elements should be of TealDataset\\(Connector\\) or TealDataConnector class" - ) -}) - -testthat::test_that("TealData$new sets join_keys datasets based on the passed join_keys input otherwise empty", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), fk = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - - join_keys1 <- join_keys(join_key("df1", "df1", "id"), join_key("df2", "df2", "df2_id")) - data <- TealData$new(df1, df2, join_keys = join_keys1) - # primary keys are not taken from datasets when calling TealData$new(), - # these are only added if using wrappers e.g. teal_data or cdisc_data - testthat::expect_equal( - data$get_join_keys(), - join_keys1 - ) - - data2 <- TealData$new(df1, df2) - testthat::expect_equal( - data2$get_join_keys(), - join_keys() - ) -}) - -testthat::test_that("TealData$new sets pull and mutate code as empty CodeClass", { - TestTealData <- R6::R6Class( # nolint - classname = "TestTealData", - inherit = TealData, - public = list( - get_mutate_code = function() private$mutate_code, - get_pull_code = function() private$pull_code - ) - ) - data <- TestTealData$new(dataset("mtcars", mtcars)) - mutate_code <- data$get_mutate_code() - pull_code <- data$get_pull_code() - - testthat::expect_s3_class(mutate_code, "CodeClass") - testthat::expect_equal(mutate_code$get_code(), "") - - testthat::expect_s3_class(pull_code, "CodeClass") - testthat::expect_equal(pull_code$get_code(), "") -}) - -testthat::test_that("copy(deep = TRUE) deep copies self and the items", { - test_ds0 <- TealDataset$new("test_ds0", head(mtcars), code = "test_ds0 <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_ds1", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - data <- TealData$new(test_ds0, test_ds1) - data_cloned <- data$copy(deep = TRUE) - testthat::expect_false(identical(data, data_cloned)) - testthat::expect_false(identical(data_cloned$get_items()$test_ds0, test_ds0)) -}) - -testthat::test_that("copy(deep = TRUE) keeps valid references between items", { - test_ds0 <- TealDataset$new("test_ds0", head(mtcars), code = "test_ds0 <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_ds1", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - data <- TealData$new(test_ds0, test_ds1) - data_cloned <- data$copy(deep = TRUE) - new_test_ds0 <- data_cloned$get_items()$test_ds0 - new_test_ds1 <- data_cloned$get_items()$test_ds1 - testthat::expect_identical( - new_test_ds1$get_var_r6()$test_ds0, - new_test_ds0 - ) -}) - -testthat::test_that("TealData$print prints out expected output on basic input", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), fk = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - - data <- TealData$new(df1, df2) - - out <- capture.output(print(data)) - testthat::expect_equal( - out, - c( - "A TealData object containing 2 TealDataset/TealDatasetConnector object(s) as element(s):", - "--> Element 1:", - "A TealDataset object containing the following data.frame (2 rows and 2 columns):", - " id a", - "1 A 1", - "2 B 2", - "--> Element 2:", - "A TealDataset object containing the following data.frame (2 rows and 3 columns):", - " df2_id fk b", - "1 A A 1", - "2 B B 2" - ) - ) -}) - -testthat::test_that("TealData$get_connectors returns an empty list if no connectors are provided", { - mtcars_ds1 <- TealDataset$new("cars1", head(mtcars), code = "cars1 <- head(mtcars)") - data <- TealData$new(mtcars_ds1, check = TRUE) - testthat::expect_identical(data$get_connectors(), list()) -}) - -testthat::test_that("TealData$get_connectors returns a list with the numbers of connectors provided", { - example_data_connector <- function(...) { - connectors <- list(...) - open_fun <- callable_function(library) - open_fun$set_args(list(package = "teal.data")) - con <- TealDataConnection$new(open_fun = open_fun) - TealDataConnector$new(connection = con, connectors = connectors) - } - - adsl <- scda_dataset_connector("ADSL", "adsl") - adsl_data <- example_data_connector(adsl) - mtcars_ds1 <- TealDataset$new("cars1", head(mtcars), code = "cars1 <- head(mtcars)") - data <- TealData$new(adsl_data, mtcars_ds1, check = TRUE) - testthat::expect_identical(length(data$get_connectors()), 1L) -}) - -testthat::test_that("TealData$get_items returns a dataset of the passed dataset name", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_identical(data$get_items("cars"), mtcars_ds) -}) - -testthat::test_that("TealData$get_items returns the content of the passed TealDataConnector name", { - example_data_connector <- function(...) { - connectors <- list(...) - open_fun <- callable_function(library) - open_fun$set_args(list(package = "teal.data")) - con <- TealDataConnection$new(open_fun = open_fun) - TealDataConnector$new(connection = con, connectors = connectors) - } - - adsl <- scda_dataset_connector("ADSL", "adsl") - adsl_data <- example_data_connector(adsl) - data <- TealData$new(adsl_data, check = TRUE) - testthat::expect_identical(data$get_items("ADSL"), adsl_data$get_items()$ADSL) -}) - -testthat::test_that("TealData$get_items returns a list of the contents if no dataname is defined", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_identical(data$get_items(), list(cars = mtcars_ds)) -}) - -testthat::test_that("TealData$get_items throws an error if the desired dataset is not found", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_error(data$get_items("iris"), "dataset iris not found") -}) - -testthat::test_that("TealData keeps references to the objects passed to the constructor", { - test_ds0 <- TealDataset$new("test_ds0", head(mtcars), code = "test_ds0 <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_ds1", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - data <- TealData$new(test_ds0, test_ds1) - testthat::expect_identical(data$get_items(), list(test_ds0 = test_ds0, test_ds1 = test_ds1)) -}) - -testthat::test_that("TealData$get_join_keys returns an empty joinKeys if no join_keys are passed", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_equal(data$get_join_keys(), join_keys()) -}) - -testthat::test_that("TealData$get_join_keys returns all join_keys when no input datanme is specified", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), id = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - - jk <- join_keys(join_key("df1", "df2", "id")) - data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - - testthat::expect_equal( - data$get_join_keys(), - join_keys( - join_key("df1", "df2", "id"), - join_key("df2", "df1", "id") - ) - ) -}) - -testthat::test_that("TealData$get_join_keys returns all join_keys of the single dataname specified", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), id = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - - jk <- join_keys(join_key("df1", "df2", "id")) - data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - - testthat::expect_equal( - data$get_join_keys("df1"), - list(df2 = setNames("id", "id")) - ) -}) - -testthat::test_that("TealData$get_join_keys returns the join_keys of the specified datanames", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), id = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - - jk <- join_keys(join_key("df1", "df2", "id")) - data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - - testthat::expect_equal( - data$get_join_keys("df1", "df2"), - setNames("id", "id") - ) -}) - -testthat::test_that("TealData$get_parents returns an empty list even when parents are specified", { - # Parent information is passed through the join_keys argument - this test does not create - # TealData with such a join_keys object set (it is only set for you if you call teal_data/cdisc_data) - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df1 <- CDISCTealDataset$new("df1", df1, keys = "id", parent = "parent") - data <- TealData$new(df1, check = FALSE) - testthat::expect_equal(data$get_parents(), list()) -}) - -testthat::test_that("TealData$mutate_join_keys returns a JoinKeys object with the updated join_keys", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), id = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - - jk <- join_keys(join_key("df1", "df2", "id")) - data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - - data$mutate_join_keys("df1", "df2", "id2") - updated_jks <- data$get_join_keys() - testthat::expect_equal( - updated_jks, - join_keys(join_key("df1", "df2", "id2")) - ) -}) - -testthat::test_that("TealData$mutate_join_keys changes keys for both datasets (same key in both)", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), id = c("A", "B"), b = c(1L, 2L)) - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - data <- TealData$new(df1, df2, check = FALSE) - data$mutate_join_keys("df1", "df2", "id") - - testthat::expect_equal( - data$get_join_keys(), - join_keys( - join_key("df1", "df2", "id") - ) - ) -}) - -test_that("TealData$check_metadata fails if inconsistent join_keys for given datasets", { - df_1 <- data.frame(x = 1:10, y = 1:10) - df_2 <- data.frame(u = 1:10, v = 1:10) - - constructor_wrapper <- function(join_keys) { - data <- TealData$new( - dataset("df_1", df_1), - dataset("df_2", df_2), - join_keys = join_keys - ) - } - - expect_error( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "w"))) - )$check_metadata() - ) - - expect_error( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "y", "v" = "v"))) - )$check_metadata() - ) - - expect_error( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "x"))) - )$check_metadata() - ) -}) - -test_that("TealData$check_metadata does not produce error if join_keys are consistent for given datasets", { - df_1 <- data.frame(x = 1:10, y = 1:10) - df_2 <- data.frame(u = 1:10, v = 1:10) - - constructor_wrapper <- function(join_keys) { - data <- TealData$new( - dataset("df_1", df_1), - dataset("df_2", df_2), - join_keys = join_keys - ) - } - - expect_silent( - constructor_wrapper( - join_keys = join_keys() - )$check_metadata() - ) - - expect_silent( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "u"))) - )$check_metadata() - ) - - expect_silent( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "u", "y" = "v"))) - )$check_metadata() - ) - - expect_silent( - constructor_wrapper( - join_keys = join_keys(join_key("df_2", "df_2", c("u" = "u"))) - )$check_metadata() - ) -}) - -testthat::test_that("TealData$check_metadata returns error when a column in the keys is not found", { - df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), id = c("A", "B"), b = c(1L, 2L)) - - df1 <- dataset("df1", df1, keys = "id6") - df2 <- dataset("df2", df2, keys = "df2_id") - - jk <- join_keys(join_key("df1", "df2", "id")) - data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - - testthat::expect_error( - data$check_metadata(), - "Primary keys specifed for df1 do not exist in the data." - ) -}) - -# TealData with single dataset and connector ---- -testthat::test_that("TealData with single dataset and connector", { - example_data_connector <- function(...) { - connectors <- list(...) - open_fun <- callable_function(library) - open_fun$set_args(list(package = "teal.data")) - con <- TealDataConnection$new(open_fun = open_fun) - TealDataConnector$new(connection = con, connectors = connectors) - } - - adsl <- scda_dataset_connector("ADSL", "adsl") - adsl_data <- example_data_connector(adsl) - - adtte <- dataset( - dataname = "ADTTE", - x = synthetic_cdisc_dataset(dataset_name = "adtte", archive_name = "latest"), - code = "ADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" - ) - - data <- TealData$new(adsl_data, adtte) - items <- data$get_items() - testthat::expect_length(items, 2) - testthat::expect_true(inherits(data, "TealData")) - testthat::expect_true(inherits(items$ADSL, "TealDatasetConnector")) - testthat::expect_true(inherits(items$ADTTE, "TealDataset")) - - connectors <- data$get_connectors() - testthat::expect_length(connectors, 1) - testthat::expect_true(inherits(connectors[[1]], "TealDataConnector")) - - testthat::expect_equal( - items$ADSL$get_pull_callable()$get_call(), - "scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" - ) - - testthat::expect_identical(adtte$get_raw_data(), items$ADTTE$get_raw_data()) - - # simulate pull with a click of the submit button - for (connector in data$get_connectors()) { - connector$pull() - } - - testthat::expect_equal( - data$get_code("ADSL"), - paste0( - "library(package = \"teal.data\")\n", - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" - ) - ) - testthat::expect_equal( - data$get_code("ADTTE"), - paste0( - "library(package = \"teal.data\")\n", - "ADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" - ) - ) - - testthat::expect_equal( - data$get_code(), - paste0( - "library(package = \"teal.data\")\n", - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\n", - "ADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" - ) - ) -}) - -# TealData with mutliple datasets and connectors ---- -testthat::test_that("TealData with mutliple datasets and connectors", { - example_data_connector <- function(...) { - connectors <- list(...) - open_fun <- callable_function(library) - open_fun$set_args(list(package = "teal")) - con <- teal.data:::TealDataConnection$new(open_fun = open_fun) - x <- teal.data:::TealDataConnector$new(connection = con, connectors = connectors) - x$set_ui( - function(id, connection, connectors) { - ns <- NS(id) - tagList( - connection$get_open_ui(ns("open_connection")), - do.call( - what = "tagList", - args = lapply( - connectors, - function(connector) { - div( - connector$get_ui( - id = ns(connector$get_dataname()) - ), - br() - ) - } - ) - ) - ) - } - ) - return(x) - } - - adsl <- scda_dataset_connector("ADSL", "adsl") - adsl_data <- example_data_connector(adsl) - - adtte <- dataset( - dataname = "ADTTE", - x = synthetic_cdisc_dataset(dataset_name = "adtte", archive_name = "latest"), - code = "ADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" - ) - - adsl_2 <- code_dataset_connector("ADSL_2", "ADSL", keys = get_cdisc_keys("ADSL"), ADSL = adsl) - # add custom input - adsl_2$set_ui_input(function(ns) { - list( - numericInput(inputId = ns("seed"), label = "Example UI", min = 0, value = 2) - ) - }) - - advs <- scda_dataset_connector("ADVS", "advs") - advs$set_ui_input(function(ns) { - list( - numericInput(inputId = ns("seed"), label = "Example UI", min = 0, value = 4) - ) - }) - - adlb <- scda_dataset_connector("ADLB", "adlb") - - advs_adlb_data <- example_data_connector(advs, adlb) - - temp_file <- tempfile() - saveRDS(synthetic_cdisc_dataset(dataset_name = "adrs", archive_name = "latest"), file = temp_file) - adrs <- rds_dataset_connector(dataname = "ADRS", file = temp_file) - - adsamp <- script_dataset_connector( - dataname = "ADSAMP", - keys = get_cdisc_keys("ADVS"), - file = "delayed_data_script/asdamp_with_adsl.R", - ADSL = adsl, - ADVS = advs - ) - - data <- TealData$new(adsl_data, adtte, adsl_2, advs_adlb_data, adrs, adsamp) - - testthat::expect_true(inherits(data, "TealData")) - items <- data$get_items() - testthat::expect_true(all(vapply(items[-2], inherits, logical(1), "TealDatasetConnector"))) - testthat::expect_true(inherits(items$ADTTE, "TealDataset")) - - testthat::expect_equal( - items$ADSL$get_pull_callable()$get_call(), - "scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" - ) - testthat::expect_equal(items$ADSL_2$get_pull_callable()$get_call(), "ADSL") - testthat::expect_equal( - items$ADVS$get_pull_callable()$get_call(), - "scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" - ) - testthat::expect_equal( - items$ADLB$get_pull_callable()$get_call(), - "scda::synthetic_cdisc_dataset(dataset_name = \"adlb\", archive_name = \"latest\")" - ) - testthat::expect_equal( - items$ADSAMP$get_pull_callable()$get_call(), - "source(file = \"delayed_data_script/asdamp_with_adsl.R\", local = TRUE)$value" - ) - testthat::expect_identical(adtte$get_raw_data(), items$ADTTE$get_raw_data()) - - testthat::expect_equal( - data$get_code("ADSL"), - "library(package = \"teal\")\nADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" # nolint - ) - testthat::expect_equal( - data$get_code("ADSL_2"), - paste0( - "library(package = \"teal\")\n", - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\n", - "ADSL_2 <- ADSL" - ) - ) - testthat::expect_equal( - data$get_code("ADVS"), - "library(package = \"teal\")\nADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" # nolint - ) - testthat::expect_equal( - data$get_code("ADLB"), - "library(package = \"teal\")\nADLB <- scda::synthetic_cdisc_dataset(dataset_name = \"adlb\", archive_name = \"latest\")" # nolint - ) - testthat::expect_equal( - data$get_code("ADSAMP"), - paste0( - "library(package = \"teal\")\n", - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\n", - "ADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")\n", - "ADSAMP <- source(file = \"delayed_data_script/asdamp_with_adsl.R\", local = TRUE)$value" - ) - ) - testthat::expect_equal( - data$get_code("ADTTE"), - "library(package = \"teal\")\nADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" # nolint - ) -}) - -# Multiple connectors ---- -testthat::test_that("Multiple connectors", { - example_data_connector <- function(...) { - connectors <- list(...) - open_fun <- callable_function(library) - open_fun$set_args(list(package = "teal")) - con <- TealDataConnection$new(open_fun = open_fun) - TealDataConnector$new(connection = con, connectors = connectors) - } - - adsl <- scda_dataset_connector("ADSL", "adsl") - adae <- scda_dataset_connector("ADAE", "adae") - advs <- scda_dataset_connector("ADVS", "advs") - adsl_2 <- code_dataset_connector("ADSL_2", - code = "ADSL", - keys = get_cdisc_keys("ADSL"), ADSL = adsl - ) - adsl_adae <- example_data_connector(adsl, adae) - advs_adsl_2 <- example_data_connector(advs, adsl_2) - data <- TealData$new(adsl_adae, advs_adsl_2) - - items <- data$get_items() - testthat::expect_true(inherits(data, "TealData")) - testthat::expect_true(all(vapply(items, inherits, logical(1), "TealDatasetConnector"))) - testthat::expect_true(all(vapply(data$get_connectors(), inherits, logical(1), "TealDataConnector"))) - - testthat::expect_equal(names(items), c("ADSL", "ADAE", "ADVS", "ADSL_2")) - - testthat::expect_equal( - items$ADSL$get_code(), - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" - ) - testthat::expect_equal( - items$ADAE$get_code(), - "ADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" - ) - testthat::expect_equal( - items$ADVS$get_code(), - "ADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" - ) - testthat::expect_equal( - items$ADSL_2$get_code(), - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\nADSL_2 <- ADSL" - ) - - testthat::expect_equal( - data$get_code("ADSL"), - "library(package = \"teal\")\nADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" # nolint - ) - testthat::expect_equal( - data$get_code("ADAE"), - "library(package = \"teal\")\nADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" # nolint - ) - testthat::expect_equal( - data$get_code("ADVS"), - "library(package = \"teal\")\nADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" # nolint - ) - testthat::expect_equal( - data$get_code("ADSL_2"), - paste0( - "library(package = \"teal\")\n", - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\n", - "ADSL_2 <- ADSL" - ) - ) - testthat::expect_equal( - data$get_code(), - paste0( - "library(package = \"teal\")\n", - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\n", - "ADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")\n", - "ADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")\nADSL_2 <- ADSL" - ) - ) -}) diff --git a/tests/testthat/test-TealDataAbstract.R b/tests/testthat/test-TealDataAbstract.R deleted file mode 100644 index 0b1ff431f..000000000 --- a/tests/testthat/test-TealDataAbstract.R +++ /dev/null @@ -1,583 +0,0 @@ -# All TealDataAbstract tests are run using TealData objects -tealdata_mixed_call <- function(check = TRUE) { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - - load_dataset(adsl) - load_dataset(adtte) - - TealData$new(adsl, adtte, check = check) -} - -testthat::test_that("TealDataAbstract cannot be instantiated", { - testthat::expect_error(TealDataAbstract$new(), "Pure virtual method") -}) - -testthat::test_that("check returns NULL if the check parameter is false", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = FALSE) - testthat::expect_null(data$check()) -}) - -testthat::test_that("check throws an error when one of the passed datasets has empty code", { - mtcars_ds <- TealDataset$new("cars", head(mtcars)) - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_error(data$check(), "code is empty") -}) - -testthat::test_that("check returns FALSE if the code provided in datasets does not reproduce them", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(iris)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_false(data$check()) -}) - -testthat::test_that("check returns TRUE if the code is reproducible", { - data <- tealdata_mixed_call() - testthat::expect_true(data$check()) -}) - -testthat::test_that("check_reproducibility passes if the reproducibility check passes", { - data <- tealdata_mixed_call() - testthat::expect_silent(data$check_reproducibility()) -}) - -testthat::test_that("check_reproducibility throws error if reproducibility check does not pass", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(iris)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_error(data$check_reproducibility(), "Reproducibility check failed.") -}) - -testthat::test_that("get_check_result method returns TRUE if check passed", { - data <- tealdata_mixed_call() - testthat::expect_true(data$check()) - testthat::expect_true(data$get_check_result()) -}) - -testthat::test_that("get_check_result method returns NULL if check is set to FALSE", { - data <- tealdata_mixed_call(FALSE) - - testthat::expect_silent(data$check()) - testthat::expect_null(data$get_check_result()) -}) - -testthat::test_that("get_code returns the code of the datasets when no input is specified", { - data <- tealdata_mixed_call() - - testthat::expect_identical( - data$get_code(), - paste0( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", - "x <- ADSL\n", - "ADTTE <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))\n})()" - )) -}) - -testthat::test_that("get_code returns the code of the dataset specifed", { - data <- tealdata_mixed_call() - - testthat::expect_identical( - data$get_code("ADTTE"), - "ADTTE <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))\n})()" - ) -}) - -testthat::test_that("get_code returns the non deparsed code when deparse is set to FALSE", { - data <- tealdata_mixed_call() - - testthat::expect_identical( - data$get_code("ADSL", deparse = FALSE), - list( - str2lang("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))"), - str2lang("x <- ADSL") - ) - ) -}) - -testthat::test_that("get_code throws error if dataname is not character or deparse is not logical", { - data <- tealdata_mixed_call() - - testthat::expect_error( - data$get_code(1), - "Assertion on 'dataname' failed: Must be of type 'character' \\(or 'NULL'\\), not 'double'." - ) - - testthat::expect_error( - data$get_code("ADSL", deparse = "TRUE"), - "Assertion on 'deparse' failed: Must be of type 'logical flag', not 'character'." - ) -}) - -testthat::test_that("get_code_class with TRUE returns code without mutate code", { - data <- tealdata_mixed_call() - - # MUTATE - data <- data %>% - mutate_data(code = "ADSL <- dplyr::filter(ADSL, USUBJID == 'a')") %>% - mutate_dataset(dataname = "ADTTE", code = "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)") %>% - mutate_dataset(dataname = "ADSL", code = "ADSL$x <- 1") - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste0( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", - "x <- ADSL\n", - "ADTTE <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))\n})()" - ) - ) -}) - -testthat::test_that("get_code_class with FALSE returns code with mutate code", { - data <- tealdata_mixed_call() - - # MUTATE - data <- data %>% - mutate_data(code = "ADSL <- dplyr::filter(ADSL, USUBJID == 'a')") %>% - mutate_dataset(dataname = "ADTTE", code = "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)") %>% - mutate_dataset(dataname = "ADSL", code = "ADSL$x <- 1") - - - testthat::expect_identical( - data$get_code_class(FALSE)$get_code(), - paste0( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", - "x <- ADSL\n", - "ADTTE <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))\n})()\n", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")\n", - "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)\n", - "ADSL$x <- 1" - ) - ) -}) - -testthat::test_that("get_datanames returns a vector of characters", { - data <- tealdata_mixed_call() - testthat::expect_identical(data$get_datanames(), c("ADSL", "ADTTE")) -}) - -testthat::test_that("get_datanames throws error if an argument is passed", { - data <- tealdata_mixed_call() - testthat::expect_error(data$get_datanames("ADSL"), "unused argument") -}) - -testthat::test_that("get_dataset throws an error if no dataset is found with the passed name", { - data <- tealdata_mixed_call() - testthat::expect_error(data$get_dataset("iris"), "dataset iris not found") -}) - -testthat::test_that("get_dataset throws an error if passed name is not character", { - data <- tealdata_mixed_call() - testthat::expect_error(data$get_dataset(iris), "Must be of type 'string'") -}) - -testthat::test_that("get_dataset returns the dataset with the passed name", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - data <- tealdata_mixed_call() - - testthat::expect_equal( - data$get_dataset("ADSL"), - dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - ) -}) - -testthat::test_that("get_dataset returns a list of all datasets if passed NULL", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - load_dataset(adsl) - load_dataset(adtte) - - data <- tealdata_mixed_call() - testthat::expect_equal(data$get_dataset(), list(ADSL = adsl, ADTTE = adtte$get_dataset())) -}) - -testthat::test_that("get_datasets returns a list of all datasets if passed NULL", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - load_dataset(adsl) - load_dataset(adtte) - - data <- tealdata_mixed_call() - testthat::expect_equal(data$get_datasets(), list(ADSL = adsl, ADTTE = adtte$get_dataset())) -}) - -testthat::test_that("get_datasets throws an error is a dataset is not pulled yet", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - - adtte_cf2 <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte2 <- dataset_connector("ADTTE", adtte_cf2, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - - data <- TealData$new(adtte2) - testthat::expect_error(data$get_datasets(), "Not all datasets have been pulled yet.") -}) - -testthat::test_that("get_items returns all items in TealDataAbstract object when no input dataname is specified", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - load_dataset(adsl) - load_dataset(adtte) - - data <- tealdata_mixed_call(check = TRUE) - testthat::expect_equal(data$get_items(), list(ADSL = adsl, ADTTE = adtte)) -}) - -testthat::test_that("get_items returns the item of the specified input dataname", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - - load_dataset(adsl) - data <- tealdata_mixed_call(check = TRUE) - testthat::expect_equal(data$get_items("ADSL"), adsl) -}) - -testthat::test_that("get_items throws error if dataname is not found", { - data <- tealdata_mixed_call(check = TRUE) - testthat::expect_error(data$get_items("ADSL1"), "dataset ADSL1 not found") -}) - -testthat::test_that("get_check returns the check status", { - data <- tealdata_mixed_call(check = TRUE) - testthat::expect_true(data$get_check()) - - data <- tealdata_mixed_call(check = FALSE) - testthat::expect_false(data$get_check()) -}) - -testthat::test_that("is_pulled returns if the datasets are pulled", { - data <- tealdata_mixed_call() - testthat::expect_true(data$is_pulled()) -}) - -testthat::test_that("mutate updates the code", { - data <- tealdata_mixed_call() - data$mutate("ADSL$new_column <- 1") - testthat::expect_equal( - data$get_code(), - paste0( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\nx <- ADSL\n", - "ADTTE <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))\n})()\n", - "ADSL$new_column <- 1" - )) -}) - -testthat::test_that("mutate_dataset updates the code of the dataset", { - data <- tealdata_mixed_call() - data$mutate_dataset("ADSL", "ADSL$new_column <- 1") - testthat::expect_equal( - data$get_code("ADSL"), - paste0( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\nx <- ADSL\n", - "ADSL$new_column <- 1" - )) -}) - -testthat::test_that("mutate_dataset throws an error if the dataname is not found", { - data <- tealdata_mixed_call() - testthat::expect_error( - data$mutate_dataset("ADSL2", "ADSL$new_column <- 1"), - "all\\(dataname %in% self\\$get_datanames\\(\\)\\) is not TRUE" - ) -}) - -testthat::test_that("mutate_dataset throws an error if the dataname is not character", { - data <- tealdata_mixed_call() - testthat::expect_error( - data$mutate_dataset(dataname = 1, "ADSL$new_column <- 1"), - "Must be of type 'character', not 'double'." - ) -}) - -testthat::test_that("set_check sets the reproducibility check", { - data <- tealdata_mixed_call() - testthat::expect_silent(data$set_check(FALSE)) - testthat::expect_false(data$get_check()) -}) - -testthat::test_that("set_check accepts only logical input", { - data <- tealdata_mixed_call() - testthat::expect_error(data$set_check("FALSE"), "Must be of type 'logical flag', not 'character'.") -}) - -testthat::test_that("set_pull_code sets code correctly", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - data <- data <- TealData$new( - cdisc_dataset( - dataname = "ADSL", - x = adsl_raw - ), - check = TRUE - ) - testthat::expect_identical(data$get_code(), "") - - data$set_pull_code("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))") - testthat::expect_identical(data$get_code(), "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))") -}) - -testthat::test_that("set_pull_code throws error if code is not character", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - - load_dataset(adsl) - load_dataset(adtte) - - data <- TealData$new(adtte, check = TRUE) - testthat::expect_error( - data$set_pull_code(111), - "Must be of type 'string', not 'double'." - ) -}) - -testthat::test_that("set_pull_code throws error if code is specified on data and dataset levels", { - data <- tealdata_mixed_call() - testthat::expect_error( - data$set_pull_code("Add code here"), - "'code' argument should be specified only in the 'cdisc_data' or in 'cdisc_dataset' but not in both" - ) -}) - -testthat::test_that("set_pull_code throws error if TealDataAbstract has only connectors", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adsl <- dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - - load_dataset(adsl) - load_dataset(adtte) - - data <- TealData$new(adtte, check = TRUE) - testthat::expect_error( - data$set_pull_code("Add code here"), - "Connectors are reproducible by default and setting 'code' argument might break it" - ) -}) - -testthat::test_that("reassign_datasets_vars updates the references of vars in items according to items addresses", { - test_ds0 <- TealDataset$new("test_ds0", head(mtcars), code = "test_ds0 <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_ds1", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - data <- TealData$new(test_ds0, test_ds1) - - # after reassignment vars_r6, vars and muatate_vars match new reference - data_cloned <- data$clone(deep = TRUE) - cloned_items <- data$get_items() - data$reassign_datasets_vars() - - testthat::expect_identical( - data$get_items()$test_ds1$get_var_r6()$test_ds0, cloned_items$test_ds0 - ) -}) - -# private methods -testthat::test_that("check_combined_code returns TRUE when the code is reproducible", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - iris_ds <- TealDataset$new("head_iris", head(iris), code = "head_iris <- head(iris)") - data <- TealData$new(mtcars_ds, iris_ds) - testthat::expect_true(data$.__enclos_env__$private$check_combined_code()) -}) - -testthat::test_that("check_combined_code returns error when the code is not reproducible", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- mtcars") - iris_ds <- TealDataset$new("head_iris", head(iris), code = "head_iris <- iris") - data <- TealData$new(mtcars_ds, iris_ds) - testthat::expect_false(data$.__enclos_env__$private$check_combined_code()) -}) - -testthat::test_that("check_combined_code returns error when the code is not supplied", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars)) - iris_ds <- TealDataset$new("head_iris", head(iris)) - data <- TealData$new(mtcars_ds, iris_ds) - testthat::expect_error(data$.__enclos_env__$private$check_combined_code()) -}) - -testthat::test_that("get_datasets_code_class returns an empty CodeClass object when no code is passed", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars)) - iris_ds <- TealDataset$new("head_iris", head(iris)) - data <- TealData$new(mtcars_ds, iris_ds) - code_class <- data$.__enclos_env__$private$get_datasets_code_class() - testthat::expect_s3_class(code_class, "CodeClass") - testthat::expect_identical(code_class$get_code(), "") -}) - -testthat::test_that("get_datasets_code_class returns a CodeClass object with the code passed", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - iris_ds <- TealDataset$new("head_iris", head(iris), code = "head_iris <- head(iris)") - data <- TealData$new(mtcars_ds, iris_ds) - code_class <- data$.__enclos_env__$private$get_datasets_code_class() - testthat::expect_s3_class(code_class, "CodeClass") - testthat::expect_identical(code_class$get_code(), "head_mtcars <- head(mtcars)\nhead_iris <- head(iris)") -}) - -testthat::test_that("get_pull_code_class gets code correctly", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - data <- data <- TealData$new( - cdisc_dataset( - dataname = "ADSL", - x = adsl_raw - ), - check = TRUE - ) - testthat::expect_identical(data$.__enclos_env__$private$get_pull_code_class()$get_code(), "") - - data$set_pull_code("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))") - testthat::expect_identical( - data$.__enclos_env__$private$get_pull_code_class()$get_code(), - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) -}) - -testthat::test_that("set_mutate_code updates the object code", { - data <- tealdata_mixed_call() - data$.__enclos_env__$private$set_mutate_code("ADSL$new <- 1") - - testthat::expect_identical( - data$get_code(), - paste0("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", - "x <- ADSL\nADTTE <- (function() {\n as.data.frame(as.list(setNames(", - "nm = get_cdisc_keys(\"ADTTE\"))))\n})()\nADSL$new <- 1" - ) - ) -}) - -testthat::test_that("set_mutate_code accepts character code of length 1", { - data <- tealdata_mixed_call() - testthat::expect_error( - data$.__enclos_env__$private$set_mutate_code(c("ADSL$new <- 1", "ADSL$new2 <- 2")), - "Assertion failed" - ) - - testthat::expect_error(data$.__enclos_env__$private$set_mutate_code(c(1 + 1)), "Assertion failed") -}) - -testthat::test_that("set_mutate_vars appends the new mutate_vars", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - iris_ds <- TealDataset$new("head_iris", head(iris), code = "head_iris <- head(iris)") - data <- TealData$new(mtcars_ds, iris_ds) - testthat::expect_silent(data$.__enclos_env__$private$set_mutate_vars(list("A" = "A"))) - testthat::expect_identical( - data$.__enclos_env__$private$mutate_vars, - list("A" = "A") - ) -}) - -testthat::test_that("set_mutate_vars accepts a unique names list, throws error otherwise", { - mtcars_ds <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - iris_ds <- TealDataset$new("head_iris", head(iris), code = "head_iris <- head(iris)") - data <- TealData$new(mtcars_ds, iris_ds) - testthat::expect_silent(data$.__enclos_env__$private$set_mutate_vars(list("A" = "A"))) - testthat::expect_error( - data$.__enclos_env__$private$set_mutate_vars(c("A" = "A")), - "Must be of type 'list', not 'character'." - ) - testthat::expect_error( - data$.__enclos_env__$private$set_mutate_vars(list("A" = "A", "A" = "B")), - "Must have unique names, but element 2 is duplicated." - ) -}) - -testthat::test_that("check_names throws if passed two datasets with the same name", { - mtcars_ds <- TealDataset$new("cars", head(mtcars)) - mtcars_ds2 <- TealDataset$new("cars", head(mtcars)) - testthat::expect_error(TealData$new(mtcars_ds, mtcars_ds2), "TealDatasets names should be unique") -}) - -testthat::test_that("execute_mutate returns current datasets if no mutate_code", { - data <- tealdata_mixed_call() - testthat::expect_identical(data$execute_mutate(), data$get_datasets()) -}) - -testthat::test_that("execute_mutate returns updated datasets", { - data <- tealdata_mixed_call() - data %>% mutate_data("ADSL$new <- 1") - testthat::expect_silent(data$execute_mutate()) - testthat::expect_identical( - data$get_code(), - paste0("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", - "x <- ADSL\nADTTE <- (function() {\n as.data.frame(as.list(setNames(", - "nm = get_cdisc_keys(\"ADTTE\"))))\n})()\nADSL$new <- 1" - ) - ) - testthat::expect_identical(data$get_dataset("ADSL")$data$new, 1) -}) diff --git a/tests/testthat/test-TealDataConnection.R b/tests/testthat/test-TealDataConnection.R deleted file mode 100644 index 7c84ae8ca..000000000 --- a/tests/testthat/test-TealDataConnection.R +++ /dev/null @@ -1,96 +0,0 @@ -library(scda) - -testthat::test_that("data connection", { - open_fun <- callable_function(data.frame) - open_fun$set_args(list(x = 1:5)) - - close_fun <- callable_function(data.frame) - close_fun$set_args(list(x = 1:2)) - - con <- TealDataConnection$new(open_fun = open_fun, close_fun = close_fun) - con$set_open_args(args = list(y = letters[1:5])) - - testthat::expect_identical( - as.list(con$get_open_call(deparse = FALSE)), - list(as.name("data.frame"), x = 1:5, y = letters[1:5]) - ) - - testthat::expect_identical( - con$get_open_call(), - "data.frame(x = 1:5, y = c(\"a\", \"b\", \"c\", \"d\", \"e\"))" - ) - - - testthat::expect_false(con$is_opened()) - con$open() - testthat::expect_true(con$is_opened()) - - # passing arguments to open doesn't overwrite args - con$open(args = list(x = 1:5, y = LETTERS[1:5])) - testthat::expect_identical( - as.list(con$get_open_call(deparse = FALSE)), - list(as.name("data.frame"), x = 1:5, y = letters[1:5]) - ) - - - testthat::expect_identical( - con$get_open_call(), - "data.frame(x = 1:5, y = c(\"a\", \"b\", \"c\", \"d\", \"e\"))" - ) - - testthat::expect_silent( - con$close(silent = TRUE) - ) - testthat::expect_false(con$is_opened()) -}) - -testthat::test_that("data_connection returns a TealDataConnection object on basic input", { - open_fun <- callable_function(data.frame) - open_fun$set_args(list(x = 1:5)) - - close_fun <- callable_function(data.frame) - close_fun$set_args(list(x = 1:2)) - - con <- data_connection(open_fun = open_fun, close_fun = close_fun) - testthat::expect_true(inherits(con, c("TealDataConnection", "R6"))) -}) - -testthat::test_that("TealDataConnection can be initialized", { - testthat::expect_error(TealDataConnection$new(), NA) -}) - -testthat::test_that("TealDataConnection$set_preopen_server accepts the old Shiny module definition", { - mock_module <- function(input, output, session, connection) "7" - connection <- TealDataConnection$new() - testthat::expect_error(connection$set_preopen_server(mock_module), NA) -}) - -testthat::test_that("TealDataConnection$set_preopen_server accepts the new Shiny module definition", { - mock_module <- function(id, connection) shiny::moduleServer(id, module = function(input, output, session) "7") - connection <- TealDataConnection$new() - testthat::expect_error(connection$set_preopen_server(mock_module), NA) -}) - -testthat::test_that("TealDataConnection$set_open_server accepts the old Shiny module definition", { - mock_module <- function(input, output, session, connection) "7" - connection <- TealDataConnection$new() - testthat::expect_error(connection$set_open_server(mock_module), NA) -}) - -testthat::test_that("TealDataConnection$set_open_server accepts the new Shiny module definition", { - mock_module <- function(id, connection) shiny::moduleServer(id, module = function(input, output, session) "7") - connection <- TealDataConnection$new() - testthat::expect_error(connection$set_open_server(mock_module), NA) -}) - -testthat::test_that("TealDataConnection$set_close_server accepts the old Shiny module definition", { - mock_module <- function(input, output, session, connection) "7" - connection <- TealDataConnection$new() - testthat::expect_error(connection$set_close_server(mock_module), NA) -}) - -testthat::test_that("TealDataConnection$set_close_server accepts the new Shiny module definition", { - mock_module <- function(id, connection) shiny::moduleServer(id, module = function(input, output, session) "7") - connection <- TealDataConnection$new() - testthat::expect_error(connection$set_close_server(mock_module), NA) -}) diff --git a/tests/testthat/test-TealDataConnector.R b/tests/testthat/test-TealDataConnector.R deleted file mode 100644 index f4d204032..000000000 --- a/tests/testthat/test-TealDataConnector.R +++ /dev/null @@ -1,90 +0,0 @@ -library(scda) - -adsl_cf <- CallableFunction$new(function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"))))) -adae_cf <- CallableFunction$new(function() as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE"))))) -adsl <- CDISCTealDatasetConnector$new("ADSL", adsl_cf, keys = get_cdisc_keys("ADSL"), parent = character(0)) -adae <- CDISCTealDatasetConnector$new("ADAE", adae_cf, keys = get_cdisc_keys("ADAE"), parent = "ADSL") - -testthat::test_that("TealDataConnector with TealDataConnection", { - open_fun <- callable_function(data.frame) - open_fun$set_args(list(x = 1:5)) - - close_fun <- callable_function(data.frame) - set_args(x = close_fun, list(x = 1:2)) - - con <- TealDataConnection$new(open_fun = open_fun, close_fun = close_fun) - con$set_open_args(args = list(y = letters[1:5])) - con$open() - - code <- "ADSL$x <- 1" - check <- TRUE - - adsl_cf <- callable_function(function(scda_name) synthetic_cdisc_data(scda_name)$adsl) - adlb_cf <- callable_function(function(scda_name) synthetic_cdisc_data(scda_name)$adlb) - - scda1 <- cdisc_dataset_connector(dataname = "ADSL", adsl_cf, keys = get_cdisc_keys("ADSL")) - scda2 <- cdisc_dataset_connector(dataname = "ADLB", adlb_cf, keys = get_cdisc_keys("ADLB")) - - x <- TealDataConnector$new(connection = con, connectors = list(scda1, scda2)) - testthat::expect_true(inherits(x, "TealDataConnector")) - - x$set_ui(function(id, ...) { - ns <- NS(id) - tagList( - textInput(ns("scda_name"), label = "Example", value = "latest") - ) - }) - x$set_server(function(id, connectors, connection) { - lapply(connectors, function(connector) { - set_args(connector, args = list(scda_name = input$scda_name)) - connector$pull(try = TRUE) - }) - }) - - testthat::expect_true(inherits(x, c("TealDataConnector", "R6"))) - - testthat::expect_true(inherits(x$get_server(), "function")) - testthat::expect_true(inherits(x$get_ui(id = ""), c("shiny.tag"))) -}) - -testthat::test_that("TealDataConnector$print prints out expected output on basic input", { - data <- CDISCTealDataConnector$new( - connection = TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")), - connectors = list(adsl, adae) - ) - - out <- capture.output(print(data)) - testthat::expect_equal( - out, - c( - paste0( - "A currently not yet opened CDISCTealDataConnector object containing ", - "2 TealDataset/TealDatasetConnector object(s) as element(s)." - ), - "0 of which is/are loaded/pulled:", - "--> Element 1:", - "A CDISCTealDatasetConnector object, named ADSL, containing a TealDataset object that has not been loaded/pulled", - "--> Element 2:", - "A CDISCTealDatasetConnector object, named ADAE, containing a TealDataset object that has not been loaded/pulled" - ) - ) -}) - -testthat::test_that("relational_data_connector returns a TealDataConnector object on basic input", { - data <- cdisc_data_connector( - connection = TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")), - connectors = list(adsl, adae) - ) - testthat::expect_true(inherits(data, c("TealDataConnector", "TealDataAbstract", "R6"))) -}) - -testthat::test_that("relational_data_connector has input validation", { - testthat::expect_error(cdisc_data_connector( - connection = 1, - connectors = list(adsl, adae) - )) - testthat::expect_error(cdisc_data_connector( - connection = TealDataConnection$new(open_fun = CallableFunction$new(function() "open function")), - connectors = "a" - )) -}) diff --git a/tests/testthat/test-TealDataset.R b/tests/testthat/test-TealDataset.R deleted file mode 100644 index 1705e47e2..000000000 --- a/tests/testthat/test-TealDataset.R +++ /dev/null @@ -1,815 +0,0 @@ -## TealDataset ===== -testthat::test_that("TealDataset basics", { - x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = TRUE) - formatters::var_labels(x) <- c("X", "Y") - - testthat::expect_silent({ - test_ds <- TealDataset$new( - dataname = "testds", - x = x, - keys = "x", - metadata = list(A = "A", B = "B") - ) - }) - - testthat::expect_equal( - get_keys(test_ds), - "x" - ) - - testthat::expect_silent(set_keys(test_ds, "y")) - testthat::expect_equal( - get_keys(test_ds), - "y" - ) - - testthat::expect_equal(test_ds$get_metadata(), list(A = "A", B = "B")) - - df <- as.data.frame( - list(a = c("a", "a", "b", "b", "c"), b = c(1, 2, 3, 3, 4), c = c(1, 2, 3, 4, 5)) - ) - # keys checking is not immediate - ds1 <- dataset(dataname = "df", x = df, keys = character(0)) - testthat::expect_silent(ds1$check_keys()) - - ds2 <- dataset(dataname = "df", x = df, keys = character(0)) %>% set_keys(c("c")) - testthat::expect_silent(ds2$check_keys()) - - ds3 <- dataset(dataname = "df", x = df) %>% set_keys("non_existing_col") - testthat::expect_error( - ds3$check_keys(), - "Primary keys specifed for df do not exist in the data." - ) - - ds4 <- dataset(dataname = "df", x = df) %>% set_keys("a") - testthat::expect_error( - ds4$check_keys(), - "Duplicate primary key values found in the dataset 'df'" - ) -}) - -testthat::test_that("metadata not a list throws an error", { - testthat::expect_error( - dataset("x", data.frame(x = c(1, 2)), metadata = 2), - "Must be of type 'list'" - ) -}) - -testthat::test_that("metadata not a list of length one atomics throws an error", { - testthat::expect_error( - dataset("x", data.frame(x = c(1, 2)), metadata = list(x = list())), - "Must be of type 'atomic', not 'list'" - ) - testthat::expect_error( - dataset("x", data.frame(x = c(1, 2)), metadata = list(x = 1:10)), - "Must have length 1" - ) -}) - -testthat::test_that("metadata can be NULL (the default)", { - testthat::expect_error( - ds <- dataset("x", data.frame(x = c(1, 2)), metadata = NULL), - NA - ) - testthat::expect_equal(ds, dataset("x", data.frame(x = c(1, 2)))) -}) - - -testthat::test_that("TealDataset$recreate", { - ds <- TealDataset$new( - dataname = "mtcars", - x = mtcars, - keys = character(0), - code = "mtcars", - label = character(0), - vars = list(), - metadata = list(A = "A", B = "B") - ) - ds2 <- ds$recreate() - - testthat::expect_identical(ds, ds2) -}) - -testthat::test_that("TealDataset$get_*_colnames", { - df <- as.data.frame( - list( - num = c(1, 2, 3), - char = as.character(c("a", "b", "c")), - fac = factor(x = c("lev1", "lev2", "lev1"), levels = c("lev1", "lev2")) - ), - stringsAsFactors = FALSE - ) - ds <- TealDataset$new("ds", x = df) - - testthat::expect_equal(ds$get_numeric_colnames(), c("num")) - testthat::expect_equal(ds$get_character_colnames(), c("char")) - testthat::expect_equal(ds$get_factor_colnames(), c("fac")) -}) - -testthat::test_that("TealDataset$get_rownames", { - df <- as.data.frame( - list( - num = c(1, 2, 3), - char = as.character(c("a", "b", "c")), - fac = factor(x = c("lev1", "lev2", "lev1"), levels = c("lev1", "lev2")) - ), - stringsAsFactors = FALSE - ) - ds <- TealDataset$new("ds", x = df) - - testthat::expect_equal(ds$get_rownames(), c("1", "2", "3")) -}) - -testthat::test_that("TealDataset active bindings and getters", { - df <- as.data.frame( - list( - num = c(1, 2, 3), - char = as.character(c("a", "b", "c")), - fac = factor(x = c("lev1", "lev2", "lev1"), levels = c("lev1", "lev2")), - num2 = c(3, 4, 5) - ), - stringsAsFactors = FALSE - ) - ds <- TealDataset$new("ds", x = df) - - testthat::expect_equal(ds$get_ncol(), 4) - testthat::expect_equal(ds$get_nrow(), 3) - testthat::expect_equal(ds$get_colnames(), c("num", "char", "fac", "num2")) - testthat::expect_equal(ds$get_rownames(), c("1", "2", "3")) - testthat::expect_equal( - ds$raw_data, - as.data.frame( - list( - num = c(1, 2, 3), - char = as.character(c("a", "b", "c")), - fac = factor(x = c("lev1", "lev2", "lev1"), levels = c("lev1", "lev2")), - num2 = c(3, 4, 5) - ), - stringsAsFactors = FALSE - ) - ) - testthat::expect_equal(ds$var_names, ds$get_colnames()) - testthat::expect_true(is.null(ds$get_row_labels())) - - # Depreciation warnings - labs <- ds$get_column_labels() - exp <- as.character(rep(NA, 4)) - names(exp) <- c("num", "char", "fac", "num2") - testthat::expect_equal(labs, exp) -}) - -testthat::test_that("TealDataset supplementary constructors", { - file_example <- tempfile(fileext = ".R") - writeLines( - text = c( - "library(teal.data) - - # code> - x <- iris - x$a1 <- 1 - x$a2 <- 2 - - # % mutate_dataset("x$z <- c('one', 'two')") - }) - - expect_equal( - test_ds$get_raw_data(), - data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE) - ) - - expect_equal( - test_ds$get_raw_data(), - data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE) - ) - - expect_error( - object = { - test_ds %>% mutate_dataset("x <- 3") - }, - "object 'test' not found" - ) - - expect_error( - object = { - test_ds %>% mutate_dataset(c("x <- 3", "som")) - }, - "Assertion failed.+code" - ) - - expect_silent({ - test_ds <- dataset( - dataname = "x", - x = x, - keys = "x" - ) - }) - expect_error({ - test_ds_mut <- test_ds %>% mutate_dataset("testds$z <- c('one', 'two')") - }) - - expect_silent({ - test_ds <- dataset( - dataname = "testds", - x = x, - code = "testds <- whatever", - keys = "x" - ) - }) - - expect_silent({ - test_ds_mut <- mutate_dataset(test_ds, code = "testds$z <- c('one', 'two')") - }) - - expect_equal( - test_ds_mut$get_raw_data(), - data.frame( - x = c(1, 2), y = c("a", "b"), - z = c("one", "two"), - stringsAsFactors = FALSE - ) - ) - - expect_silent({ - test_ds_mut <- test_ds %>% mutate_dataset(read_script("mutate_code/testds.R")) - }) - - expect_equal( - test_ds_mut$get_raw_data(), - data.frame( - x = c(1, 2), y = c("a", "b"), - z = c(1, 1), - stringsAsFactors = FALSE - ) - ) - - expect_equal( - test_ds_mut$get_code(), - "testds <- whatever\ntestds$z <- c(\"one\", \"two\")\nmut_fun <- function(x) {\n x$z <- 1\n return(x)\n}\ntestds <- mut_fun(testds)" # nolint - ) - - expect_true(inherits(test_ds_mut, "TealDataset")) - - expect_silent({ - test_ds_mut <- test_ds %>% mutate_dataset(read_script("mutate_code/testds.R")) - }) - - expect_equal( - test_ds_mut$get_raw_data(), - data.frame( - x = c(1, 2), y = c("a", "b"), - z = c(1, 1), - stringsAsFactors = FALSE - ) - ) - - expect_equal( - test_ds_mut$get_code(), - "testds <- whatever\ntestds$z <- c(\"one\", \"two\")\nmut_fun <- function(x) {\n x$z <- 1\n return(x)\n}\ntestds <- mut_fun(testds)\nmut_fun <- function(x) {\n x$z <- 1\n return(x)\n}\ntestds <- mut_fun(testds)" # nolint - ) - - expect_true(inherits(test_ds_mut, "TealDataset")) - - expect_error( - object = { - test_ds_mut <- test_ds %>% mutate_dataset(code = "rm('testds')") - }, - "Code from testds need to return a data.frame" - ) -}) - -test_that("mutate_dataset with vars argument", { - x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE) - var1 <- "3" - var2 <- "4" - test_ds <- dataset( - dataname = "x", - x = x, - code = "data.frame(x = c(1, 2), y = c('a', 'b'), stringsAsFactors = TRUE)" - ) - expect_silent( - mutate_dataset(x = test_ds, code = "x$z <- var", vars = list(var = var1)) - ) - expect_silent( - mutate_dataset(x = test_ds, code = "x$z <- var2", vars = list(var2 = paste(var1, var2))) - ) - expect_error( - mutate_dataset(x = test_ds, code = "x$z <- var", vars = list(var = var2)) - ) - expect_silent( - mutate_dataset(x = test_ds, code = "x$zz <- var", vars = list(var = var1)) - ) - - pull_fun2 <- callable_function(data.frame) - pull_fun2$set_args(args = list(a = c(1, 2, 3))) - expect_silent({ - t <- dataset_connector("test", pull_fun2) - }) - expect_silent(load_dataset(t)) - expect_silent( - mutate_dataset(x = t, code = "test$z <- var", vars = list(var = var1)) - ) - expect_silent( - mutate_dataset(x = t, code = "test$z <- var2", vars = list(var2 = paste(var1, var2))) - ) - expect_error( - mutate_dataset(x = t, code = "test$z <- var", vars = list(var = var2)) - ) - expect_silent( - mutate_dataset(x = t, code = "test$zz <- var", vars = list(var = var1)) - ) -}) - -testthat::test_that("dataset$print warns of superfluous arguments", { - x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE) - test_ds <- dataset( - dataname = "x", - x = x, - code = "data.frame(x = c(1, 2), y = c('a', 'b'), stringsAsFactors = FALSE)" - ) - testthat::expect_warning( - capture.output(print(test_ds, "un used argument")) - ) -}) - -testthat::test_that("dataset$print prints out all rows when less than 6", { - x <- data.frame(x = c(1, 2), y = c("a", "b"), stringsAsFactors = FALSE) - test_ds <- dataset( - dataname = "x", - x = x, - code = "data.frame(x = c(1, 2), y = c('a', 'b'), stringsAsFactors = FALSE)" - ) - - testthat::expect_equal( - capture.output(print(test_ds)), - c( - "A TealDataset object containing the following data.frame (2 rows and 2 columns):", - " x y", - "1 1 a", - "2 2 b" - ) - ) -}) - -testthat::test_that("dataset$print truncates output after 6 rows", { - x <- head(iris, 7) - test_ds <- dataset( - dataname = "x", - x = x, - code = "head(iris, 7)" - ) - - testthat::expect_equal( - capture.output(print(test_ds)), - c( - "A TealDataset object containing the following data.frame (7 rows and 5 columns):", - " Sepal.Length Sepal.Width Petal.Length Petal.Width Species", - "1 5.1 3.5 1.4 0.2 setosa", - "2 4.9 3.0 1.4 0.2 setosa", - "3 4.7 3.2 1.3 0.2 setosa", - "4 4.6 3.1 1.5 0.2 setosa", - "5 5.0 3.6 1.4 0.2 setosa", - "6 5.4 3.9 1.7 0.4 setosa", - "..." - ) - ) -}) - -testthat::test_that("get_var_r6 returns identical R6 objects as passed with set_vars", { - test_ds0 <- TealDataset$new("mtcars", mtcars) - test_ds1 <- TealDataset$new("iris", iris) - test_ds1$set_vars(vars = list(test_ds0 = test_ds0)) - - vars <- test_ds1$get_var_r6() - testthat::expect_identical(vars$test_ds0, test_ds0) -}) - -testthat::test_that("clone(deep = TRUE) deep clones dependencies, which are TealDataset objects", { - test_ds0 <- TealDataset$new("mtcars", mtcars) - test_ds1 <- TealDataset$new("iris", iris) - test_ds1$set_vars(vars = list(test_ds0 = test_ds0)) - test_ds1_cloned <- test_ds1$clone(deep = TRUE) - testthat::expect_false( - identical(test_ds1_cloned$get_var_r6()$test_ds0, test_ds0) - ) -}) - -testthat::test_that("reassign_datasets_vars updates the references of the vars to - addresses of passed objects", { - test_ds0 <- TealDataset$new("mtcars", mtcars) - test_ds1 <- TealDataset$new("iris", iris) - test_ds1$set_vars(vars = list(test_ds0 = test_ds0)) - - # after reassignment vars_r6, vars and muatate_vars match new reference - test_ds0_cloned <- test_ds0$clone(deep = TRUE) - test_ds1$reassign_datasets_vars(list(test_ds0 = test_ds0_cloned)) - - vars <- test_ds1$get_vars() - testthat::expect_identical(vars$test_ds0, test_ds0_cloned) -}) - -testthat::test_that("reassign_datasets_vars updates the references of the vars_r6 to - addresses of passed objects", { - test_ds0 <- TealDataset$new("mtcars", mtcars) - test_ds1 <- TealDataset$new("iris", iris) - test_ds1$set_vars(vars = list(test_ds0 = test_ds0)) - - # after reassignment vars_r6, vars and muatate_vars match new reference - test_ds0_cloned <- test_ds0$clone(deep = TRUE) - test_ds1$reassign_datasets_vars(list(test_ds0 = test_ds0_cloned)) - - vars_r6 <- test_ds1$get_var_r6() - testthat::expect_identical(vars_r6$test_ds0, test_ds0_cloned) -}) - -testthat::test_that("reassign_datasets_vars does not change `vars` elements of - class different than TealDataset and TealDatasetConnector", { - test_ds0 <- mtcars - test_ds1 <- TealDataset$new("mtcars", mtcars) - test_ds2 <- TealDataset$new("iris", iris) - test_ds2$set_vars(vars = list(test_ds0 = test_ds0, test_ds1 = test_ds1)) - - test_ds2$reassign_datasets_vars(list(test_ds1 = test_ds1)) - testthat::expect_identical(test_ds2$get_vars()$test_ds0, test_ds0) -}) - -testthat::test_that("reassign_datasets_vars does not change any `vars` while - empty list is provided", { - test_ds0 <- mtcars - test_ds1 <- TealDataset$new("mtcars", mtcars) - test_ds2 <- TealDataset$new("iris", iris) - test_ds2$set_vars(vars = list(test_ds0 = test_ds0, test_ds1 = test_ds1)) - - test_ds2$reassign_datasets_vars(list()) - testthat::expect_identical(test_ds2$get_vars()$test_ds0, test_ds0) - testthat::expect_identical(test_ds2$get_vars()$test_ds1, test_ds1) -}) diff --git a/tests/testthat/test-TealDatasetConnector.R b/tests/testthat/test-TealDatasetConnector.R deleted file mode 100644 index cbab7e15e..000000000 --- a/tests/testthat/test-TealDatasetConnector.R +++ /dev/null @@ -1,1178 +0,0 @@ -library(scda) - -# Test TealDatasetConnector ------ -testthat::test_that("TealDatasetConnector", { - fun <- callable_function(function() synthetic_cdisc_data("latest")$adsl) - - testthat::expect_error(dataset_connector(pull_callable = fun), "dataname") - testthat::expect_silent( - x1 <- dataset_connector( - dataname = "ADSL", - pull_callable = fun, - keys = get_cdisc_keys("ADSL") - ) - ) - - - testthat::expect_identical( - x1$get_code(deparse = TRUE), - "ADSL <- (function() synthetic_cdisc_data(\"latest\")$adsl)()" - ) - - testthat::expect_equal( - x1$get_code(deparse = FALSE), - as.list(as.call(parse(text = 'ADSL <- (function() synthetic_cdisc_data("latest")$adsl)()'))) - ) - - testthat::expect_error(x1$get_dataset(), "'ADSL' has not been pulled yet") - testthat::expect_error(get_dataset(x1), "'ADSL' has not been pulled yet") - testthat::expect_error(x1$get_raw_data(), "'ADSL' has not been pulled yet") - testthat::expect_silent(x1$pull()) - testthat::expect_true(inherits(x1$get_dataset(), "TealDataset")) - testthat::expect_identical( - get_keys(get_dataset(x1)), - get_keys(x1) - ) - - testthat::expect_identical( - x1$get_raw_data(), - synthetic_cdisc_data("latest")$adsl - ) - - testthat::expect_silent( - x2 <- dataset_connector( - dataname = "ADSL", - pull_callable = fun, - keys = get_cdisc_keys("ADSL") - ) - ) - - testthat::expect_identical( - get_keys(x2), - get_cdisc_keys("ADSL") - ) - - testthat::expect_silent(x2$pull()) - testthat::expect_identical( - get_keys(x2), - get_keys(get_dataset(x2)) - ) - - fun <- callable_function(data.frame) - fun$set_args(list(id = 1:3, marker = c(100, 1, 10), alive = TRUE)) - fun$set_args(list(new_feature = c(3, 4, 1))) - - testthat::expect_silent( - x3 <- dataset_connector( - dataname = "ADSL", - pull_callable = fun, - keys = "id" - ) - ) - - testthat::expect_identical( - x3$get_code(), - "ADSL <- data.frame(id = 1:3, marker = c(100, 1, 10), alive = TRUE, new_feature = c(3, 4, 1))" - ) - - m <- mutate_dataset(x3, "ADSL$newest <- 'xxx'") - - testthat::expect_silent(load_dataset(m)) - - testthat::expect_silent( - m <- mutate_dataset(x3, "ADSL$newest2 <- 'best'") - ) - - testthat::expect_true(inherits(get_dataset(m), "TealDataset")) - - testthat::expect_identical( - m$get_raw_data(), - data.frame( - id = 1:3, marker = c(100, 1, 10), alive = TRUE, new_feature = c(3, 4, 1), - newest = "xxx", newest2 = "best", stringsAsFactors = FALSE - ) - ) -}) - -testthat::test_that("metadata for TealDatasetConnector can be Callable, list or NULL", { - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(a = c(1, 2, 3))) - metadata_fun <- callable_function(function(a, b) list(A = a, B = b)) - metadata_fun$set_args(args = list(a = TRUE, b = 12)) - - testthat::expect_error(dataset_connector("test", pull_fun, metadata = list(A = TRUE)), NA) - testthat::expect_error(dataset_connector("test", pull_fun, metadata = NULL), NA) - testthat::expect_error(dataset_connector("test", pull_fun, metadata = metadata_fun), NA) -}) - -# Test conversions -testthat::test_that("scda_dataset_connector", { - x <- scda_cdisc_dataset_connector(dataname = "ADSL", "adsl") - x2 <- scda_dataset_connector( - dataname = "ADSL", - "adsl", - keys = get_cdisc_keys("ADSL") - ) %>% - as_cdisc() - testthat::expect_equal(x, x2) - testthat::expect_true(inherits(x, "TealDatasetConnector")) - - testthat::expect_identical( - x$.__enclos_env__$private$pull_callable$.__enclos_env__$private$fun_name, - "scda::synthetic_cdisc_dataset" - ) - - testthat::expect_identical(x$get_dataname(), "ADSL") - testthat::expect_equal( - x$get_code(), - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" - ) - - testthat::expect_silent(load_dataset(x)) - testthat::expect_identical(x$get_raw_data(), synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest")) - testthat::expect_equal(x$get_dataset()$get_metadata(), list(type = "scda", version = "latest")) -}) - -testthat::test_that("rds_dataset_connector", { - x <- rds_cdisc_dataset_connector( - dataname = "ADSL", - file = "./data_connectors/table.rds" - ) - x2 <- rds_dataset_connector( - dataname = "ADSL", - file = "./data_connectors/table.rds", - keys = get_cdisc_keys("ADSL") - ) %>% - as_cdisc() - - testthat::expect_error( - rds_cdisc_dataset_connector(dataname = "ADSL", file = "./data_connectors/table_notexists.rds") - ) - - testthat::expect_equal(x, x2) - testthat::expect_true(inherits(x, "TealDatasetConnector")) - testthat::expect_equal(x$get_code(), "ADSL <- readRDS(file = \"./data_connectors/table.rds\")") -}) - -# test with unexpected input -testthat::test_that("csv_dataset_connector not expected input", { - - # check error if csv file doesn't exist - testthat::expect_error(csv_dataset_connector("ADSL", file = "not_exists.csv", keys = get_cdisc_keys("ADSL"))) - - # check error if args are named - testthat::expect_error( - csv_dataset_connector("ADSL", - file = temp_file_csv, - keys = get_cdisc_keys("ADSL"), - code = character(0), - script = character(0), - label = character(0), - "a" - ) - ) - testthat::expect_error(csv_dataset_connector("ADSL", file = c("a", "b")), regexp = "Assertion on 'file'") - testthat::expect_error(csv_dataset_connector("ADSL", file = 1), regexp = "Assertion on 'file'") -}) - -# test with cdisc data input -testthat::test_that("csv_dataset_connector scda", { - # create csv file - adsl <- synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest") - temp_file_csv <- tempfile(fileext = ".csv") - write.csv(adsl, file = temp_file_csv, row.names = FALSE) - - # check can pull data and get code without delimiter assigned - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv) - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \",\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(adsl)) - testthat::expect_identical(colnames(data), colnames(adsl)) - - # next check can pass arguments to read_delim (e.g. delim = '|') - temp_file_csv <- tempfile(fileext = ".csv") - write.table(adsl, file = temp_file_csv, row.names = FALSE, sep = "|") - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, delim = "|") - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \"|\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(adsl)) - testthat::expect_identical(ncol(data), ncol(adsl)) - testthat::expect_identical(colnames(data), colnames(adsl)) - - # next check can pass arguments to read_delim (using '\t') - temp_file_csv <- tempfile(fileext = ".csv") - write.table(adsl, file = temp_file_csv, row.names = FALSE, sep = "\t") - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, delim = "\t") - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \"\\t\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(adsl)) - testthat::expect_identical(ncol(data), ncol(adsl)) - testthat::expect_identical(colnames(data), colnames(adsl)) - - # next check can pass arguments to read_delim (using ';') - temp_file_csv <- tempfile(fileext = ".csv") - write.table(adsl, file = temp_file_csv, row.names = FALSE, sep = ";") - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, delim = ";") - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \";\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(adsl)) - testthat::expect_identical(ncol(data), ncol(adsl)) - testthat::expect_identical(colnames(data), colnames(adsl)) -}) - -# non-standard dataset -testthat::test_that("csv_dataset_connector non-standard datasets multi/space character delim", { - test_adsl <- synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest") - test_adsl_ns <- data.frame( - STUDYID = "A", - USUBJID = paste0("A", 1:3), - SUBJID = 1:3, - RACE = c("sth1|sth2", "sth", "sth"), - stringsAsFactors = FALSE - ) - - # next check can pass arguments to read_delim (using '$') - temp_file_csv <- tempfile(fileext = ".csv") - write.table(test_adsl_ns, file = temp_file_csv, row.names = FALSE, sep = "$") - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, delim = "$") - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \"$\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(test_adsl_ns)) - testthat::expect_equal(colnames(x$get_raw_data()), colnames(test_adsl_ns)) - - # next check can pass arguments to read_delim (using space ' ') - temp_file_csv <- tempfile(fileext = ".csv") - write.table(test_adsl, file = temp_file_csv, row.names = FALSE, sep = " ") - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, keys = get_cdisc_keys("ADSL"), delim = " ") - testthat::expect_warning(x$pull()) - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), paste0( - "ADSL <- readr::read_delim(file = \"", - encodeString(temp_file_csv), "\", delim = \" \")" - ) - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_false(identical(data, test_adsl)) -}) - -# column names attributes -testthat::test_that("csv_dataset_connector attritubes", { - ADSL_ns <- data.frame( # nolint - STUDYID = "A", - USUBJID = paste0("A", 1:3), - SUBJID = 1:3, - RACE = c("sth1|sth2", "sth", "sth"), - stringsAsFactors = FALSE - ) - formatters::var_labels(ADSL_ns) <- letters[1:4] # nolint - temp_file_csv <- tempfile(fileext = ".csv") - write.table(ADSL_ns, file = temp_file_csv, row.names = FALSE, sep = ",") - - # check can pull data and get code - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, delim = ",") - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \",\")") - ) - data <- x$get_raw_data() - testthat::expect_null(attributes(data[[1]])$label) - - # we should use mutate_dataset - data <- (x %>% mutate_dataset("formatters::var_labels(ADSL) <- letters[1:4]"))$get_raw_data() - testthat::expect_identical(attributes(data[[1]])$label, "a") -}) - -# test csv_cdisc_dataset_connector -testthat::test_that("csv_cdisc_dataset_connector scda", { - # create csv file - adsl <- synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest") - temp_file_csv <- tempfile(fileext = ".csv") - write.csv(adsl, file = temp_file_csv, row.names = FALSE) - - # check can pull data and get code without delimiter assigned - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv) - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \",\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(adsl)) - testthat::expect_identical(colnames(data), colnames(adsl)) - - # next check can pass arguments to read_delim (e.g. delim = '|') - temp_file_csv <- tempfile(fileext = ".csv") - write.table(adsl, file = temp_file_csv, row.names = FALSE, sep = "|") - x <- csv_cdisc_dataset_connector("ADSL", file = temp_file_csv, delim = "|") - x$pull() - testthat::expect_true(is_pulled(x)) - testthat::expect_identical(get_dataname(x), "ADSL") - testthat::expect_identical( - x$get_code(), - paste0("ADSL <- readr::read_delim(file = \"", encodeString(temp_file_csv), "\", delim = \"|\")") - ) - data <- x$get_raw_data() - testthat::expect_true(is.data.frame(data)) - testthat::expect_identical(nrow(data), nrow(adsl)) - testthat::expect_identical(ncol(data), ncol(adsl)) - testthat::expect_identical(colnames(data), colnames(adsl)) -}) - -testthat::test_that("script_dataset_connector", { - file_example <- tempfile(fileext = ".R") - writeLines( - text = c( - " - library(scda) - ADSL <- synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\") - ADSL" - ), - con = file_example - ) - - x <- script_dataset_connector( - dataname = "ADSL", - file = file_example, - keys = get_cdisc_keys("ADSL") - ) - - wrong_file <- "notexists.R" - testthat::expect_error( - script_dataset_connector( - dataname = "ADSL", - file = wrong_file, - keys = get_cdisc_keys("ADSL") - ), - sprintf("File %s does not exist.", wrong_file) - ) - - load_dataset(x) - testthat::expect_true(inherits(get_dataset(x), "TealDataset")) - testthat::expect_true(inherits(x$get_raw_data(), "data.frame")) -}) - -testthat::test_that("script_cdisc_dataset_connector", { - file_example <- tempfile(fileext = ".R") - writeLines( - text = c( - " - library(scda) - ADSL <- synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\") - ADSL" - ), - con = file_example - ) - - x <- script_cdisc_dataset_connector(dataname = "ADSL", file = file_example) - testthat::expect_silent(load_dataset(x)) - testthat::expect_true(inherits(get_dataset(x), "TealDataset")) - testthat::expect_true(inherits(x$get_raw_data(), "data.frame")) -}) - -testthat::test_that("fun_cdisc_dataset_connector", { - my_data_1 <- function() { - set.seed(1234) - # whatever code - require(dplyr) - x <- data.frame( - STUDYID = 1, - USUBJID = 1:40, - z = stats::rnorm(40), - zz = factor(sample(letters[1:3], 40, replace = TRUE)), - NAs = rep(NA, 40) - ) - x$w <- as.numeric(rnorm(40, 0, 1)) - x$ww <- as.numeric(rnorm(40, 0, 1)) - formatters::var_labels(x) <- c("STUDYID", "USUBJID", "z", "zz", "NAs", "w", "ww") - x - } - - global_var <- 40 - my_data_wrong <- function() { - # whatever code - set.seed(1234) - x <- data.frame( - STUDYID = 1, - USUBJID = 1:global_var, - z = stats::rnorm(40), - zz = factor(sample(letters[1:3], 40, replace = TRUE)), - NAs = rep(NA, 40) - ) - x$w <- as.numeric(rnorm(40, 0, 1)) - x$ww <- as.numeric(rnorm(40, 0, 1)) - formatters::var_labels(x) <- c("STUDYID", "USUBJID", "z", "zz", "NAs", "w", "ww") - x - } - - y_1 <- fun_cdisc_dataset_connector(dataname = "ADSL", fun = my_data_1) - y_wrong <- fun_cdisc_dataset_connector(dataname = "ADSL", fun = my_data_wrong) - y_1$pull() - - expect_equal(environmentName(environment(my_data_wrong)), environmentName(environment(my_data_1))) - - expect_error(y_wrong$pull()) - - expect_identical(y_1$get_raw_data(), my_data_1()) - - fun_direct <- fun_cdisc_dataset_connector( - dataname = "ADSL", - fun = synthetic_cdisc_dataset, - fun_args = list(dataset_name = "adsl", archive_name = "latest") - ) - - fun_direct2 <- fun_cdisc_dataset_connector( - dataname = "ADSL", - fun = scda::synthetic_cdisc_dataset, - fun_args = list(dataset_name = "adsl", archive_name = "latest") - ) - fun_direct$pull() - - fun_direct2$pull() - - data_1 <- fun_direct$get_raw_data() - data_2 <- fun_direct2$get_raw_data() - - testthat::expect_true(is.data.frame(data_1)) - testthat::expect_true(is.data.frame(data_2)) - expect_identical(data_1, data_2) -}) - -testthat::test_that("code_dataset_connector - Test various inputs", { - adsl <- synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest") - - file_example <- tempfile(fileext = ".R") - writeLines( - text = c("ADSL <- synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\nADSL"), - con = file_example - ) - - from_file <- code_dataset_connector(dataname = "ADSL", code = paste0(readLines(file_example), collapse = "\n")) - - expect_equal( - from_file$get_code(), - "ADSL <- synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\nADSL <- ADSL" - ) - expect_identical(from_file$pull()$get_raw_data(), adsl) - - adsl <- synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest") - - file_example <- tempfile(fileext = ".R") - writeLines( - text = c( - "mtcars - # code ADSL> - library(scda) - ADSL <- synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\") - ADSL - # % - set_args(args = list(dataset_name = "adsl", archive_name = "latest")), - keys = get_cdisc_keys("ADSL"), - label = "ADSL dataset" - ) - - adtte <- dataset_connector( - dataname = "ADTTE", - pull_callable = callable_code( - "library(dplyr) - synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\") %>% - filter(SEX == 'F')" - ), - keys = get_cdisc_keys("ADTTE"), - label = "ADTTE dataset" - ) - - adrs <- dataset_connector( - dataname = "ADRS", - pull_callable = callable_code( - "library(dplyr) - synthetic_cdisc_dataset(dataset_name = \"adrs\", archive_name = \"latest\") %>% - filter(SEX == 'F')" - ), - keys = get_cdisc_keys("ADRS"), - label = "ADRS dataset" - ) - - data <- cdisc_data(adsl, adtte, adrs, check = TRUE) - expect_silent( - lapply( - data$get_items(), - load_dataset - ) - ) - - datasets <- get_datasets(data) - expect_identical( - datasets[[1]]$get_raw_data(), - synthetic_cdisc_dataset(dataset_name = "adsl", archive_name = "latest") - ) - - expect_identical( - unique(datasets[[2]]$get_raw_data()$SEX), - factor("F", levels = c("F", "M")) - ) - - expect_identical( - unique(datasets[[3]]$get_raw_data()$SEX), - factor("F", levels = c("F", "M")) - ) -}) - -testthat::test_that("TealDatasetConnector mutate method with delayed logic", { - test_ds1 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - test_ds2 <- TealDataset$new("head_iris", head(iris), code = "head_iris <- head(iris)") - testthat::expect_true(all(test_ds1$check(), test_ds2$check())) - - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(head_letters = head(letters))) - t_dc <- dataset_connector("test_dc", pull_fun, vars = list(test_ds1 = test_ds1)) - - pull_fun2 <- callable_function(data.frame) - pull_fun2$set_args(args = list(head_integers = 1:6)) - t_dc2 <- dataset_connector("test_dc2", pull_fun2, vars = list(test_ds2 = test_ds2)) - - testthat::expect_false(t_dc$is_mutate_delayed()) - # mutation is delayed when data hasn't been loaded/pulled yet. - mutate_dataset(t_dc, code = "test_dc$tail_letters <- tail(letters)") - testthat::expect_true(t_dc$is_mutate_delayed()) - testthat::expect_equal( - pretty_code_string(t_dc$get_code()), - c( - "head_mtcars <- head(mtcars)", - "test_ds1 <- head_mtcars", - "test_dc <- data.frame(head_letters = c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"))", - "test_dc$tail_letters <- tail(letters)" - ) - ) - testthat::expect_false(t_dc$is_pulled()) - load_dataset(t_dc) - testthat::expect_false(t_dc$is_mutate_delayed()) - testthat::expect_true(all(c("head_letters", "tail_letters") %in% names(t_dc$get_raw_data()))) - - testthat::expect_equal( - pretty_code_string(t_dc$get_code()), - c( - "head_mtcars <- head(mtcars)", - "test_ds1 <- head_mtcars", - "test_dc <- data.frame(head_letters = c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"))", - "test_dc$tail_letters <- tail(letters)" - ) - ) - - # mutation is delayed because t_dc2 hasn't been loaded yet - mutate_dataset(t_dc, code = "test_dc$head_integers <- t_dc2$head_integers", vars = list(t_dc2 = t_dc2)) - testthat::expect_true(t_dc$is_mutate_delayed()) - testthat::expect_equal( - pretty_code_string(t_dc$get_code()), - c( - "head_mtcars <- head(mtcars)", - "test_ds1 <- head_mtcars", - "test_dc <- data.frame(head_letters = c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"))", - "head_iris <- head(iris)", - "test_ds2 <- head_iris", - "test_dc2 <- data.frame(head_integers = 1:6)", - "t_dc2 <- test_dc2", - "test_dc$tail_letters <- tail(letters)", - "test_dc$head_integers <- t_dc2$head_integers" - ) - ) - # mutation is delayed even, though it could be executed, because it had already been delayed - mutate_dataset(t_dc, code = "test_dc$one <- 1") - testthat::expect_true(t_dc$is_mutate_delayed()) - testthat::expect_equal( - pretty_code_string(t_dc$get_code()), - c( - "head_mtcars <- head(mtcars)", - "test_ds1 <- head_mtcars", - "test_dc <- data.frame(head_letters = c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"))", - "head_iris <- head(iris)", - "test_ds2 <- head_iris", - "test_dc2 <- data.frame(head_integers = 1:6)", - "t_dc2 <- test_dc2", - "test_dc$tail_letters <- tail(letters)", - "test_dc$head_integers <- t_dc2$head_integers", - "test_dc$one <- 1" - ) - ) - - load_dataset(t_dc2) - # testing t_dc$pull, which re-runs all (already executed and staged) mutate code - # "head_letters" and "tail_letters" columns had already been executed - # "head_integers" and "one" columns are delayed - load_dataset(t_dc) - testthat::expect_true(all(c("head_letters", "tail_letters", "head_integers", "one") %in% names(t_dc$get_raw_data()))) - testthat::expect_false(t_dc$is_mutate_delayed()) - - # mutate should again be eager - mutate_dataset(t_dc2, code = "test_dc2$five <- 5") - testthat::expect_equal(t_dc2$get_raw_data()$five, rep(5, 6)) - - mutate_dataset(t_dc, code = "test_dc$five <- t_dc2$five", vars = list(t_dc2 = t_dc2)) - testthat::expect_equal(t_dc$get_raw_data()$five, rep(5, 6)) - testthat::expect_false(t_dc$is_mutate_delayed()) - - # multiple lines of identical code - mutate_dataset(t_dc, code = "test_dc$five <- 2 * test_dc$five") - mutate_dataset(t_dc, code = "test_dc$five <- 2 * test_dc$five") - mutate_dataset(t_dc, code = "test_dc$five <- 2 * test_dc$five") - testthat::expect_equal(t_dc$get_raw_data()$five, rep(40, 6)) - testthat::expect_false(t_dc$is_mutate_delayed()) - - # multi layer dependencies - pull_fun3 <- callable_function(data.frame) - pull_fun3$set_args(args = list(neg_integers = -(1:6))) # nolint - t_dc3 <- dataset_connector("test_dc3", pull_fun3) - - mutate_dataset(t_dc2, code = "test_dc2$neg_integers <- t_dc3$neg_integers", vars = list(t_dc3 = t_dc3)) - testthat::expect_true(t_dc2$is_mutate_delayed()) - - # t_dc doesn't know that t_dc2 is delayed - testthat::expect_false(t_dc$is_mutate_delayed()) - # delayed, even though the column is ready, because t_dc2 is delayed by t_dc3 - mutate_dataset(t_dc, code = "test_dc$six <- test_dc$five + 1", vars = list(t_dc2 = t_dc2)) - testthat::expect_true(t_dc$is_mutate_delayed()) - - testthat::expect_true( - all(c("test_dc2$neg_integers <- t_dc3$neg_integers", "test_dc$six <- test_dc$five + 1") %in% - pretty_code_string(t_dc$get_code())) - ) - testthat::expect_true(t_dc$is_mutate_delayed()) - - mutate_dataset(t_dc, code = "test_dc$seven <- 7") - testthat::expect_true("test_dc$seven <- 7" %in% pretty_code_string(t_dc$get_code())) - testthat::expect_true(t_dc$is_mutate_delayed()) - # confirming that mutation has not happened - testthat::expect_silent(t_dc$get_raw_data()) - load_dataset(t_dc3) - testthat::expect_false(any(c("six", "seven") %in% names(t_dc$get_raw_data()))) - - # current state - testthat::expect_true(all( - names(t_dc$get_raw_data()) %in% c("head_letters", "tail_letters", "head_integers", "one", "five") - )) - - # load_dataset, which calls pull method, will reset to original state because dependencies have changed - load_dataset(t_dc) - - testthat::expect_true(t_dc$is_mutate_delayed()) - # original state. all columns resulting from mutations have been removed - testthat::expect_true(all(names(t_dc$get_raw_data()) %in% c("head_letters"))) - # still it must return code from all previously inputted mutate statements - testthat::expect_true( - "test_dc$seven <- 7" %in% pretty_code_string(t_dc$get_code()) - ) - - # confirming that mutation has not happened - testthat::expect_false(any(c("six", "seven") %in% names(t_dc$get_raw_data()))) - # confirming that mutation is delayed - testthat::expect_true(t_dc2$is_mutate_delayed()) - - # confirming get_raw_data will eager mutate t_dc2 because t_dc3 has been loaded - testthat::expect_true(all(c("head_integers", "five", "neg_integers") %in% names(t_dc2$get_raw_data()))) - - # re running all mutation statements - load_dataset(t_dc) - testthat::expect_false(t_dc$is_mutate_delayed()) - testthat::expect_true(all(c( - "head_integers", "tail_letters", "head_integers", "one", "five", "six", "seven" - ) %in% names(t_dc$get_raw_data()))) - - testthat::expect_equal(t_dc$get_raw_data()$seven, rep(7, 6)) - testthat::expect_equal(t_dc$get_raw_data()$six, rep(41, 6)) - testthat::expect_equal(t_dc$get_raw_data()$five, rep(40, 6)) - # back to eager mutate - mutate_dataset(t_dc, code = "test_dc$eight <- 8") - testthat::expect_equal(t_dc$get_raw_data()$eight, rep(8, 6)) -}) - -testthat::test_that("TealDatasetConnector mutate method edge cases", { - # edge because test_ds1 does not contain the code to recreate head_mtcars - test_ds1 <- TealDataset$new("head_mtcars", head(mtcars)) - - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(head_letters = head(letters))) - t_dc <- dataset_connector("test_dc", pull_fun) - load_dataset(t_dc) - testthat::expect_silent( - mutate_dataset(t_dc, code = "test_dc$new_var <- head_mtcars$carb", vars = list(head_mtcars = test_ds1)) - ) - testthat::expect_equal(t_dc$get_raw_data()$new_var, c(4, 4, 1, 1, 2, 1)) -}) - -testthat::test_that("get_code_class returns the correct CodeClass object", { - cc1 <- CodeClass$new(code = "iris <- (function() head(iris))()", dataname = "iris") - cf1 <- CallableFunction$new(function() head(iris)) - dc1 <- TealDatasetConnector$new("iris", cf1) - testthat::expect_equal(dc1$get_code_class(), cc1) -}) - -testthat::test_that("Pulled TealDatasetConnector returns the same CodeClass as before pulling", { - cf1 <- CallableFunction$new(function() head(iris)) - dc1 <- TealDatasetConnector$new("iris", cf1) - pre_pull_cc <- dc1$get_code_class() - dc1$pull() - post_pull_cc <- dc1$get_code_class() - - testthat::expect_equal(post_pull_cc, pre_pull_cc) -}) - -testthat::test_that("Pulled dependent TealDatasetConnector returns the same CodeClass as before pulling", { - ds <- TealDataset$new("iris", head(iris), code = "iris <- head(iris)") - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf, vars = list(iris = ds)) - pre_pull_code_class <- dc$get_code_class() - dc$pull() - post_pull_code_class <- dc$get_code_class() - testthat::expect_equal(post_pull_code_class, pre_pull_code_class) -}) - -testthat::test_that("Pulling twice doesn't change the returned TealDatasetConnector's CodeClass", { - ds <- TealDataset$new("iris", head(iris), code = "iris <- head(iris)") - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf, vars = list(iris = ds)) - dc$pull() - pre_pull_code_class <- dc$get_code_class() - dc$pull() - post_pull_code_class <- dc$get_code_class() - testthat::expect_equal(post_pull_code_class, pre_pull_code_class) -}) - -testthat::test_that("Identical mutation expressions are added to the mutation code", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$mutate("mtcars$test <- 1") - dc$mutate("mtcars$test <- 1") - testthat::expect_equal(dc$get_code(), "mtcars <- (function() head(mtcars))()\nmtcars$test <- 1\nmtcars$test <- 1") -}) - -testthat::test_that("Identical mutation expressions are executed upon pulling the Connector object", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$mutate("mtcars$test <- 1") - dc$mutate("mtcars$test <- mtcars$test * 2") - dc$mutate("mtcars$test <- mtcars$test * 2") - dc$pull() - testthat::expect_equal(dc$get_raw_data()$test, rep(4, 6)) -}) - -testthat::test_that("Identical mutation expressions are shown in the returned code after pulling", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$mutate("mtcars$test <- 1") - dc$mutate("mtcars$test <- mtcars$test * 2") - dc$mutate("mtcars$test <- mtcars$test * 2") - dc$pull() - testthat::expect_equal( - dc$get_code(), - paste( - "mtcars <- (function() head(mtcars))()", - "mtcars$test <- 1", - "mtcars$test <- mtcars$test * 2", - "mtcars$test <- mtcars$test * 2", - sep = "\n" - ) - ) -}) - -testthat::test_that("TealDatasetConnector$is_mutate_delayed is FALSE if not yet pulled and not mutated", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - testthat::expect_false(dc$is_mutate_delayed()) -}) - -testthat::test_that("TealDatasetConnector$is_mutate_delayed returns FALSE if pulled and not mutated", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$pull() - testthat::expect_false(dc$is_mutate_delayed()) -}) - -testthat::test_that("TealDatasetConnector$is_mutate_delayed returns TRUE if not pulled and mutated", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$mutate(code = "test") - testthat::expect_true(dc$is_mutate_delayed()) -}) - -testthat::test_that("TealDatasetConnector$is_mutate_delayed returns TRUE if mutated with no delayed objects and pulled", { # nolint - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$mutate(code = "") - dc$pull() - testthat::expect_false(dc$is_mutate_delayed()) -}) - -testthat::test_that("TealDatasetConnector$is_mutate_delayed returns FALSE if mutated with no vars after pulling", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$pull() - dc$mutate(code = "") - testthat::expect_false(dc$is_mutate_delayed()) -}) - -testthat::test_that("TealDatasetConnector returns the correct code when mutated with no vars after pulling", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$pull() - dc$mutate(code = "1") - testthat::expect_equal(dc$get_code_class()$get_code(), "mtcars <- (function() head(mtcars))()\n1") -}) - -testthat::test_that("Pulling an already pulled TealDatasetConnector after mutating it with a delayed object - undoes any eager pre-pull mutations", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$pull() - dc$mutate(code = "mtcars[1] <- NULL") - dc$mutate( - code = "", - vars = list(delayed = TealDatasetConnector$new("iris", CallableFunction$new(function() head(iris)))) - ) - dc$pull() - testthat::expect_equal(dc$get_raw_data(), head(mtcars)) -}) - -testthat::test_that("Pulling an already pulled TealDatasetConnector after mutating it with a delayed object - does not change the returned code", { - cf <- CallableFunction$new(function() head(mtcars)) - dc <- TealDatasetConnector$new("mtcars", cf) - dc$pull() - dc$mutate(code = "mtcars[1] <- NULL") - dc$mutate( - code = "", - vars = list(delayed = TealDatasetConnector$new("iris", CallableFunction$new(function() head(iris)))) - ) - pre_pull_code <- dc$get_code() - dc$pull() - testthat::expect_equal(dc$get_code(), pre_pull_code) -}) - -testthat::test_that("Initializing TealDatasetConnector with code argument works", { - test_ds1 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(head_letters = head(letters))) - t_dc <- dataset_connector( - "test_dc", - pull_fun, - code = "test_dc$tail_letters = tail(letters)", - vars = list(test_ds1 = test_ds1) - ) - testthat::expect_equal( - t_dc$get_code(), - "head_mtcars <- head(mtcars)\ntest_ds1 <- head_mtcars\ntest_dc <- data.frame(head_letters = c(\"a\", \"b\", \"c\", \"d\", \"e\", \"f\"))\ntest_dc$tail_letters = tail(letters)" # nolint - ) - testthat::expect_equal( - attr(t_dc$get_code_class()$code[[1]], "dataname"), - "head_mtcars" - ) - testthat::expect_equal( - attr(t_dc$get_code_class()$code[[2]], "dataname"), - "head_mtcars" - ) - testthat::expect_equal( - attr(t_dc$get_code_class()$code[[3]], "dataname"), - "test_dc" - ) - # mutate code passed in as string values will have dataset name as its dataname attribute - testthat::expect_equal( - attr(t_dc$get_code_class()$code[[4]], "dataname"), - "test_dc" - ) - t_dc$pull() - testthat::expect_equal( - t_dc$get_raw_data(), - data.frame(head_letters = head(letters), tail_letters = tail(letters)) - ) -}) - -testthat::test_that("TealDatasetConnector$print does not print dataset when not yet pulled", { - test_ds1 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(head_letters = head(letters))) - t_dc <- dataset_connector("test_dc", pull_fun, vars = list(test_ds1 = test_ds1)) - - out <- capture.output(print(t_dc)) - - testthat::expect_equal( - out, - "A TealDatasetConnector object, named test_dc, containing a TealDataset object that has not been loaded/pulled" - ) -}) - -testthat::test_that("TealDatasetConnector$print prints dataset when it is pulled", { - test_ds1 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(head_letters = head(letters))) - t_dc <- dataset_connector("test_dc", pull_fun, vars = list(test_ds1 = test_ds1)) - t_dc$pull() - out <- capture.output(print(t_dc)) - - testthat::expect_equal( - out, - c( - "A TealDatasetConnector object, named test_dc, containing a TealDataset object that has been loaded/pulled:", - "A TealDataset object containing the following data.frame (6 rows and 1 columns):", - " head_letters", - "1 a", - "2 b", - "3 c", - "4 d", - "5 e", - "6 f" - ) - ) -}) - -testthat::test_that("get_var_r6 returns identical objects as these passed to the vars argument in - the constructor", { - test_ds0 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_dc", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - - vars <- test_ds1$get_var_r6() - testthat::expect_identical(vars$test_ds0, test_ds0) -}) - -testthat::test_that("clone(deep = TRUE) deep clones dependencies, which are TealDataset objects", { - test_ds0 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_dc", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - test_ds1_cloned <- test_ds1$clone(deep = TRUE) - testthat::expect_false( - identical(test_ds1_cloned$get_var_r6()$test_ds0, test_ds0) - ) -}) - -testthat::test_that("reassign_datasets_vars updates the references of the vars to - addresses of passed objects", { - test_ds0 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_dc", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - - # after reassignment vars_r6, vars and muatate_vars match new reference - test_ds0_cloned <- test_ds0$clone(deep = TRUE) - test_ds1$reassign_datasets_vars(datasets = list(test_ds0 = test_ds0_cloned)) - - vars <- test_ds1$.__enclos_env__$private$pull_vars - testthat::expect_identical(vars$test_ds0, test_ds0_cloned) -}) - -testthat::test_that("reassign_datasets_vars updates the references of the vars_r6 to - addresses of passed objects", { - test_ds0 <- TealDataset$new("head_mtcars", head(mtcars), code = "head_mtcars <- head(mtcars)") - test_ds1 <- TealDatasetConnector$new( - dataname = "test_dc", - pull_callable = CallableFunction$new(data.frame), - vars = list(test_ds0 = test_ds0) - ) - - # after reassignment vars_r6, vars and muatate_vars match new reference - test_ds0_cloned <- test_ds0$clone(deep = TRUE) - test_ds1$reassign_datasets_vars(datasets = list(test_ds0 = test_ds0_cloned)) - - vars_r6 <- test_ds1$get_var_r6() - testthat::expect_identical(vars_r6$test_ds0, test_ds0_cloned) -}) - -testthat::test_that("reassign_datasets_vars does not change `vars` elements of - class different than TealDataset and TealDatasetConnector", { - test_ds0 <- mtcars - test_ds1 <- TealDataset$new("mtcars", mtcars) - test_ds2 <- TealDatasetConnector$new( - dataname = "iris", - pull_callable = callable_function(data.frame), - vars = list(test_ds0 = test_ds0, test_ds1 = test_ds1) - ) - - test_ds2$reassign_datasets_vars(list(test_ds1 = test_ds1)) - testthat::expect_identical( - test_ds2$.__enclos_env__$private$pull_vars$test_ds0, - test_ds0 - ) -}) - -testthat::test_that("reassign_datasets_vars does not change any `vars` while - empty list is provided", { - test_ds0 <- mtcars - test_ds1 <- TealDataset$new("mtcars", mtcars) - test_ds2 <- TealDataset$new("iris", iris) - test_ds2 <- TealDatasetConnector$new( - dataname = "iris", - pull_callable = callable_function(data.frame), - vars = list(test_ds0 = test_ds0, test_ds1 = test_ds1) - ) - - test_ds2$reassign_datasets_vars(list()) - testthat::expect_identical( - test_ds2$.__enclos_env__$private$pull_vars$test_ds0, - test_ds0 - ) - testthat::expect_identical( - test_ds2$.__enclos_env__$private$pull_vars$test_ds1, - test_ds1 - ) -}) - - -testthat::test_that("Callable metadata is pulled when data is pulled", { - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(a = c(1, 2, 3))) - metadata_fun <- callable_function(function(a, b) list(A = a, B = b)) - metadata_fun$set_args(args = list(a = TRUE, b = 12)) - x <- dataset_connector("test", pull_fun, metadata = metadata_fun) - x$pull() - - testthat::expect_equal( - x$get_dataset()$get_metadata(), - list(A = TRUE, B = 12) - ) -}) - -testthat::test_that("list metadata is passed to dataset when data is pulled", { - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(a = c(1, 2, 3))) - x <- dataset_connector("test", pull_fun, metadata = list(foo = "bar")) - x$pull() - - testthat::expect_equal( - x$get_dataset()$get_metadata(), - list(foo = "bar") - ) -}) - -testthat::test_that("if pulling metadata fails, dataset is still created but metadata is NULL", { - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(a = c(1, 2, 3))) - metadata_fun <- callable_function(function(a, b) stop("An error")) - metadata_fun$set_args(args = list(a = TRUE, b = 12)) - x <- dataset_connector("test", pull_fun, metadata = metadata_fun) - - testthat::expect_output(load_dataset(x), "TealDatasetConnector\\$pull pulling metadata failed for dataset: test") - testthat::expect_null(x$get_dataset()$get_metadata()) - testthat::expect_true(x$is_pulled()) -}) - - -testthat::test_that("if pulled metadata is invalid, dataset is still created but metadata is NULL", { - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(a = c(1, 2, 3))) - metadata_fun <- callable_function(function(a, b) 1:10) - metadata_fun$set_args(args = list(a = TRUE, b = 12)) - x <- dataset_connector("test", pull_fun, metadata = metadata_fun) - - testthat::expect_output(load_dataset(x), "TealDatasetConnector\\$pull invalid metadata for dataset: test") - testthat::expect_null(x$get_dataset()$get_metadata()) - testthat::expect_true(x$is_pulled()) -}) diff --git a/tests/testthat/test-TealDatasetConnector_constructors.R b/tests/testthat/test-TealDatasetConnector_constructors.R deleted file mode 100644 index 342cb9270..000000000 --- a/tests/testthat/test-TealDatasetConnector_constructors.R +++ /dev/null @@ -1,7 +0,0 @@ -testthat::test_that("code_dataset_connector returns the same object as TealDatasetConnector", { - x <- code_dataset_connector(dataname = "test", code = "head(mtcars)") - expected <- TealDatasetConnector$new(dataname = "test", pull_callable = callable_function(function() head(mtcars))) - x$pull() - expected$pull() - testthat::expect_equal(x$get_dataset()$data, expected$get_dataset()$data) -}) diff --git a/tests/testthat/test-as_cdisc.R b/tests/testthat/test-as_cdisc.R deleted file mode 100644 index eb44beb19..000000000 --- a/tests/testthat/test-as_cdisc.R +++ /dev/null @@ -1,43 +0,0 @@ -testthat::test_that("as_cdisc does not modify a cdisc-flavoured object", { - ds <- cdisc_dataset("ADSL", as.data.frame(setNames(nm = get_cdisc_keys("ADSL")))) - testthat::expect_identical(as_cdisc(ds), ds) - conn <- cdisc_dataset_connector( - "ADSL", - callable_code("as.data.frame(setNames(nm = get_cdisc_keys(\"ADSL\")))"), - keys = get_cdisc_keys("ADSL") - ) - testthat::expect_identical(as_cdisc(conn), conn) -}) - -testthat::test_that("as_cdisc passes keys from dataset to cdisc dataset", { - ds <- dataset( - "ADSL", - as.data.frame(setNames(nm = c(get_cdisc_keys("ADSL"), "SUBJID"))), - keys = c("STUDYID", "USUBJID", "SUBJID") - ) - cdisc_ds <- as_cdisc(ds) - testthat::expect_equal(get_keys(cdisc_ds), get_keys(ds)) -}) - -testthat::test_that("as_cdisc passes metadata from dataset to cdisc dataset", { - ds <- dataset( - "ADSL", - as.data.frame(setNames(nm = c(get_cdisc_keys("ADSL"), "SUBJID"))), - keys = c("STUDYID", "USUBJID", "SUBJID"), - metadata = list(A = TRUE, B = "x") - ) - cdisc_ds <- as_cdisc(ds) - testthat::expect_equal(cdisc_ds$get_metadata(), ds$get_metadata()) -}) - -testthat::test_that("as_cdisc assigns cdisc keys if dataset has no keys and name matches cdisc", { - ds <- dataset("ADSL", as.data.frame(setNames(nm = get_cdisc_keys("ADSL")))) - testthat::expect_length(get_keys(ds), 0) - testthat::expect_equal(get_keys(as_cdisc(ds)), get_cdisc_keys("ADSL")) -}) - -testthat::test_that("as_cdisc does not assign cdisc keys if dataset has no keys, but name does not match cdisc", { - ds <- dataset("test", as.data.frame(setNames(nm = get_cdisc_keys("ADSL")))) - testthat::expect_length(get_keys(ds), 0) - testthat::expect_equal(get_keys(as_cdisc(ds)), get_keys(ds)) -}) diff --git a/tests/testthat/test-data_label.R b/tests/testthat/test-data_label.R deleted file mode 100644 index 80f231d10..000000000 --- a/tests/testthat/test-data_label.R +++ /dev/null @@ -1,55 +0,0 @@ -testthat::test_that("get_labels returns a list with two keys", { - testthat::expect_equal(names(get_labels(iris, fill = TRUE)), c("dataset_label", "column_labels")) -}) - -testthat::test_that("get_labels accepts an empty data.frame", { - testthat::expect_error(get_labels(data.frame()), regexp = NA) -}) - -testthat::test_that("get_labels' dataset_label is NULL if the dataset has no label attribute", { - testthat::expect_null(get_labels(iris, fill = TRUE)$dataset_label) -}) - -testthat::test_that("get_labels' dataset_label is equal to the label attribute of the passed data.frame", { - custom_iris <- iris - attributes(custom_iris)$label <- "Test" - testthat::expect_equal(get_labels(custom_iris, fill = TRUE)$dataset_label, "Test") -}) - -testthat::test_that("get_labels' column_labels is NULL for a data.frame with no columns", { - testthat::expect_null(get_labels(data.frame()[1:5, ], fill = TRUE)$column_labels) -}) - -testthat::test_that("get_labels' column_labels is a named vector of NA when fill = FALSE and there are no labels", { - testthat::expect_equal( - get_labels(iris, fill = FALSE)$column_labels, - stats::setNames(rep(NA_character_, times = ncol(iris)), nm = colnames(iris)) - ) -}) - -testthat::test_that("get_labels' column labels is a vector of column names when fill = TRUE and there are no labels", { - testthat::expect_equal( - get_labels(iris, fill = TRUE)$column_labels, - stats::setNames(colnames(iris), nm = colnames(iris)) - ) -}) - -testthat::test_that("get_labels' column_labels is a named vector of the labels of the passed data.frame", { - test <- data.frame(a = 1, b = 2) - test_labels <- c("testa", "testb") - attr(test[[1]], "label") <- test_labels[1] - attr(test[[2]], "label") <- test_labels[2] - testthat::expect_equal(get_labels(test)$column_labels, stats::setNames(object = test_labels, nm = colnames(test))) -}) - -testthat::test_that("get_cdisc_keys returns column names present in the cached datasets", { - scda_data <- scda::synthetic_cdisc_data("latest") - - datasets <- c("ADSL", "ADAE", "ADTTE", "ADCM", "ADLB", "ADRS", "ADVS") - datasets_small <- c("adsl", "adae", "adtte", "adcm", "adlb", "adrs", "advs") - - sapply(seq_along(datasets), function(x) { - testthat::expect_true( - all(get_cdisc_keys(datasets[x]) %in% names(scda_data[[datasets_small[x]]]))) - }) -}) diff --git a/tests/testthat/test-get_raw_data.R b/tests/testthat/test-get_raw_data.R deleted file mode 100644 index 1eb2233a0..000000000 --- a/tests/testthat/test-get_raw_data.R +++ /dev/null @@ -1,128 +0,0 @@ -library(scda) - -testthat::test_that("get_raw_data validates the argument dataname", { - x <- dataset(dataname = "head_iris", x = head(iris)) - - testthat::expect_error(get_raw_data(x, dataname = 1)) - testthat::expect_silent(get_raw_data(x)) - testthat::expect_warning(get_raw_data(x, "dataname")) -}) - -testthat::test_that("get_raw_data.TealDataset returns a data.frame verbatim ", { - x <- dataset(dataname = "head_iris", x = head(iris)) - - testthat::expect_identical( - get_raw_data(x), - head(iris) - ) -}) - -testthat::test_that("get_raw_data.TealDataset gives warning when dataname is supplied ", { - x <- dataset(dataname = "head_iris", x = head(iris)) - - testthat::expect_warning( - get_raw_data(x, dataname = "dataname") - ) -}) - -testthat::test_that("get_raw_data.TealDatasetConnector returns a SCDA data frame verbatim ", { - pull_fun_iris <- callable_function( - function() { - iris - } - ) - dc <- dataset_connector("ADSL", pull_fun_iris) - load_dataset(dc) - - testthat::expect_identical( - get_raw_data(dc), - iris - ) -}) - -testthat::test_that("get_raw_data.TealDatasetConnector gives warning when dataname is supplied ", { - pull_fun_iris <- callable_function( - function() { - iris - } - ) - dc <- dataset_connector("ADSL", pull_fun_iris) - load_dataset(dc) - - testthat::expect_warning( - get_raw_data(dc, dataname = "dataname") - ) -}) - -testthat::test_that("get_raw_data.TealDataAbstract returns dataset objects verbatim when input is TealData", { - x <- dataset(dataname = "head_iris", x = head(iris)) - - y <- dataset(dataname = "head_mtcars", x = head(mtcars)) - - rd <- TealData$new(x, y) - - out <- get_raw_data(rd) - - testthat::expect_equal(length(out), 2) - - testthat::expect_identical(out$head_iris, head(iris)) - testthat::expect_identical(out$head_mtcars, head(mtcars)) -}) - -testthat::test_that( - "get_raw_data.TealDataAbstract returns dataset objects verbatim when input is TealData", - code = { - x <- dataset(dataname = "head_iris", x = head(iris)) - - y <- dataset(dataname = "head_mtcars", x = head(mtcars)) - - rd <- TealData$new(x, y) - - out <- get_raw_data(rd) - - testthat::expect_equal(length(out), 2) - - testthat::expect_identical(out$head_iris, head(iris)) - testthat::expect_identical(out$head_mtcars, head(mtcars)) - } -) - -testthat::test_that( - "get_raw_data.TealDataAbstract returns dataset objects verbatim when input is TealDataConnector or CDISCTealData", - code = { - adsl_cf <- callable_function(function() synthetic_cdisc_data("latest")$adsl) - adsl <- cdisc_dataset_connector( - dataname = "ADSL", - pull_callable = adsl_cf, - keys = get_cdisc_keys("ADSL") - ) - load_dataset(adsl) - adlb_cf <- callable_function(function() synthetic_cdisc_data("latest")$adlb) - adlb <- cdisc_dataset_connector( - dataname = "ADLB", - pull_callable = adlb_cf, - keys = get_cdisc_keys("ADLB") - ) - load_dataset(adlb) - - rdc <- relational_data_connector( - connection = data_connection(), - connectors = list(adsl, adlb) - ) - - out <- get_raw_data(rdc) - - testthat::expect_equal(length(out), 2) - - adsl <- synthetic_cdisc_data("latest")$adsl - adlb <- synthetic_cdisc_data("latest")$adlb - testthat::expect_identical(out$ADSL, adsl) - testthat::expect_identical(out$ADLB, adlb) - - drc <- cdisc_data(rdc) - out_cdisc <- get_raw_data(drc) - - testthat::expect_identical(out_cdisc$ADSL, adsl) - testthat::expect_identical(out_cdisc$ADLB, adlb) - } -) diff --git a/tests/testthat/test-is_pulled.R b/tests/testthat/test-is_pulled.R deleted file mode 100644 index cc89241c1..000000000 --- a/tests/testthat/test-is_pulled.R +++ /dev/null @@ -1,35 +0,0 @@ -test_that("Test TealDataset is_pulled", { - rel_data <- dataset( - dataname = "XY", - x = head(iris), - keys = character(0) - ) - expect_true(is_pulled(rel_data)) -}) - -test_that("Test TealDatasetConnector is_pulled", { - iris <- TealDatasetConnector$new(dataname = "iris", CallableFunction$new(function() head(iris))) - testthat::expect_false(is_pulled(iris)) - - load_dataset(iris) - testthat::expect_true(is_pulled(iris)) -}) - -test_that("Test TealDataConnector is_pulled", { - adsl_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - } - ) - adrs_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADRS")))) - } - ) - adsl <- cdisc_dataset_connector(dataname = "ADSL", adsl_cf, keys = get_cdisc_keys("ADSL")) - adrs <- cdisc_dataset_connector(dataname = "ADRS", adrs_cf, keys = get_cdisc_keys("ADRS")) - - rdc <- cdisc_data(adsl, adrs) - - expect_false(is_pulled(rdc)) -}) diff --git a/tests/testthat/test-to_relational_data.R b/tests/testthat/test-to_relational_data.R deleted file mode 100644 index 3e93bd13c..000000000 --- a/tests/testthat/test-to_relational_data.R +++ /dev/null @@ -1,148 +0,0 @@ -dataset_1 <- dataset("iris", head(iris)) -adsl_df <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) -adsl_dataset <- cdisc_dataset( - "ADSL", adsl_df, - parent = character(0), keys = get_cdisc_keys("ADSL") -) - -to_relational_data_wrapper <- function(data) { - to_relational_data(data) -} - -test_that("to_relational_data accepts data.frame as input", { - iris <- head(iris) - output <- to_relational_data_wrapper(iris) - testthat::expect_error(output, NA) - testthat::expect_is(output, "TealData") -}) - -test_that("to_relational_data accepts cdisc data.frame as input", { - output <- to_relational_data_wrapper(adsl_df) - testthat::expect_error(output, NA) - testthat::expect_is(output, "TealData") -}) - -test_that("to_relational_data accepts TealDataset/CDISCTealDataset as input", { - output_dataset <- to_relational_data(dataset_1) - testthat::expect_error(output_dataset, NA) - testthat::expect_is(output_dataset, "TealData") - - output_cdisc_dataset <- to_relational_data(adsl_dataset) - testthat::expect_error(output_cdisc_dataset, NA) - testthat::expect_is(output_cdisc_dataset, "TealData") -}) - -test_that("to_relational_data accepts TealDatasetConnector as input", { - dsc1 <- dataset_connector("iris", callable_function(function() head(iris))) - output_datasetconnector <- to_relational_data(dsc1) - testthat::expect_error(output_datasetconnector, NA) - testthat::expect_is(output_datasetconnector, "TealData") - testthat::expect_identical(output_datasetconnector$get_datanames(), "iris") -}) - -test_that("to_relational_data accepts an unnamed list of data.frame as input", { - output_dataset_list <- to_relational_data_wrapper(list(iris)) - testthat::expect_error(output_dataset_list, NA) - testthat::expect_is(output_dataset_list, "TealData") - testthat::expect_identical(output_dataset_list$get_datanames(), "iris") -}) - -test_that("to_relational_data accepts a named list of data.frame as input", { - output_dataset_list <- to_relational_data_wrapper(list(AA = head(iris))) - testthat::expect_error(output_dataset_list, NA) - testthat::expect_is(output_dataset_list, "TealData") - testthat::expect_identical(output_dataset_list$get_datanames(), "AA") -}) - -test_that("to_relational_data accepts a mixed named list of data.frame as input", { - head_mtcars <- head(mtcars) # wouldn't be a valid R object name (head(mtcars)) - output_dataset_list <- to_relational_data_wrapper(list(AA = head(iris), head_mtcars)) - testthat::expect_error(output_dataset_list, NA) - testthat::expect_is(output_dataset_list, "TealData") - testthat::expect_identical(output_dataset_list$get_datanames(), c("AA", "head_mtcars")) -}) - -test_that("to_relational_data accepts a complete named list of data.frame as input", { - output_dataset_list <- to_relational_data_wrapper(list(AA = head(iris), BB = head(mtcars))) - testthat::expect_error(output_dataset_list, NA) - testthat::expect_is(output_dataset_list, "TealData") - testthat::expect_identical(output_dataset_list$get_datanames(), c("AA", "BB")) -}) - -test_that("to_relational_data accepts a mixed named list of objects as input", { - dataset_22 <- dataset("iris22", head(iris)) - dsc1 <- dataset_connector("dsc1", callable_function(function() head(iris))) - - output_dataset_list <- to_relational_data_wrapper(list(AA = head(iris), dataset_22)) - testthat::expect_error(output_dataset_list, NA) - testthat::expect_is(output_dataset_list, "TealData") - testthat::expect_identical(output_dataset_list$get_datanames(), c("AA", "iris22")) - - output_dataset_list2 <- to_relational_data_wrapper(list(AA = head(iris), dataset_22, mtcars, dsc1)) - testthat::expect_error(output_dataset_list2, NA) - testthat::expect_is(output_dataset_list2, "TealData") - testthat::expect_identical(output_dataset_list2$get_datanames(), c("AA", "iris22", "mtcars", "dsc1")) -}) - -test_that("to_relational_data accepts a function returning a named list as input", { - fun <- function() list(AA = adsl_df, BB = adsl_df) - - output_dataset_fun <- to_relational_data_wrapper(fun()) - testthat::expect_error(output_dataset_fun, NA) - testthat::expect_is(output_dataset_fun, "TealData") - testthat::expect_identical(output_dataset_fun$get_datanames(), c("AA", "BB")) -}) - -test_that("to_relational_data accepts a function returning a TealDataset as input", { - fun <- function() cdisc_dataset("ADSL", adsl_df) - - output_dataset_fun <- to_relational_data(fun()) - testthat::expect_error(output_dataset_fun, NA) - testthat::expect_is(output_dataset_fun, "TealData") - testthat::expect_identical(output_dataset_fun$get_datanames(), "ADSL") -}) - -test_that("to_relational_data accepts a MultiAssayExperiment as input", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- miniACC - output_dataset <- to_relational_data(mae) - testthat::expect_is(output_dataset, "TealData") - testthat::expect_identical(output_dataset$get_datanames(), "MAE") -}) - - -test_that("to_relational_data accepts a list containing a named MultiAssayExperiment as input", { - utils::data(miniACC, package = "MultiAssayExperiment") - mae <- miniACC - output_dataset <- to_relational_data(list(aa = mae)) - testthat::expect_is(output_dataset, "TealData") - testthat::expect_identical(output_dataset$get_datanames(), "aa") -}) - -test_that("to_relational_data throws error with a function returning a non-named list", { - fun <- function() list(iris, mtcars) - - testthat::expect_error( - to_relational_data_wrapper(fun()), - "Unnamed lists shouldn't be provided as input for data. Please use a named list." - ) -}) - -test_that("to_relational_data throws error with a function returning a semi-named list", { - fun <- function() list(iris = iris, mtcars) - - testthat::expect_error( - to_relational_data_wrapper(fun()), - "Unnamed lists shouldn't be provided as input for data. Please use a named list." - ) -}) - -test_that("to_relational_data throws error with a multiple functions returning data.frame", { - fun_iris <- function() iris - fun_mtcars <- function() mtcars - - testthat::expect_error( - to_relational_data_wrapper(setNames(nm = c("AA"), list(fun_iris(), fun_mtcars()))), - "Unnamed lists shouldn't be provided as input for data. Please use a named list." - ) -}) diff --git a/tests/testthat/test-utils.R b/tests/testthat/test-utils.R index e3a315dc9..628e39789 100644 --- a/tests/testthat/test-utils.R +++ b/tests/testthat/test-utils.R @@ -16,7 +16,7 @@ test_that("get_key_duplicates_util function", { expect_error(get_key_duplicates_util(df, keys = c("a", "test"))) # single duplicated value - expect_true(dplyr::all_equal( + expect_true(all.equal( data.frame(a = factor("b", levels = c("a", "b", "c")), b = 3, rows = "3,4", n = 2L), get_key_duplicates_util(df, keys) )) @@ -28,7 +28,7 @@ test_that("get_key_duplicates_util function", { stringsAsFactors = TRUE ) keys <- c("a") - expect_true(dplyr::all_equal( + expect_true(all.equal( data.frame(a = factor(c("a", "b"), levels = c("a", "b", "c")), rows = c("1,2", "3,4"), n = c(2L, 2L)), get_key_duplicates_util(df, keys) )) @@ -40,7 +40,7 @@ test_that("get_key_duplicates_util function", { ) keys <- c("a", "b") - expect_true(dplyr::all_equal( + expect_true(all.equal( data.frame(a = factor(x = NULL, levels = c("a", "b", "c")), b = double(0), rows = character(0), n = integer(0)), get_key_duplicates_util(df, keys) ))