From 36090d28724548734ddc2513af6ab9d3b354c6fe Mon Sep 17 00:00:00 2001 From: Mahmoud Hallal <86970066+mhallal1@users.noreply.github.com> Date: Wed, 8 Feb 2023 14:22:25 +0100 Subject: [PATCH] add cdisc information into JoinKeys (#132) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit closes #120 - removed `CDISCTealData` and replaced its functionality with `TealData`. - removed `join_keys` mentions in `TealDataset` and `TealDatasetConnector`. - updated wrappers `cdisc_data` and `teal_data` to set up join_keys by calling `JoinKeys` functionalities. They check if `join_keys` are passed otherwise they create them according to primary keys. - deprecated `cdisc_data_file` - Added tests to `test-joinKeys.R` - Updated and added tests of `test-TealData`, `test-TealDataAbstract`, `test-cdisc_data` and `test-teal_data`. - updated `teal.slice::init_filtered_data` to remove `CDISCTealData` S3 method and to account for `cdisc` status in the `TealData` S3 method: https://github.com/insightsengineering/teal.slice/pull/169 --------- Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com> Co-authored-by: Arkadiusz Beer Co-authored-by: Andrew Bates Co-authored-by: Dawid Kałędkowski --- NEWS.md | 4 + R/CDISCTealData.R | 270 ----- R/JoinKeys.R | 107 +- R/TealData.R | 125 +- R/TealDataAbstract.R | 7 +- R/TealDataConnector.R | 4 +- R/TealDataset.R | 44 - R/TealDatasetConnector.R | 41 - R/cdisc_data.R | 165 +++ R/teal_data.R | 46 +- _pkgdown.yml | 25 +- man/CDISCTealData.Rd | 122 -- man/CDISCTealDataset.Rd | 4 - man/CDISCTealDatasetConnector.Rd | 3 - man/JoinKeys.Rd | 70 ++ man/MAETealDataset.Rd | 4 - man/TealData.Rd | 72 +- man/TealDataConnector.Rd | 2 +- man/TealDataset.Rd | 80 -- man/TealDatasetConnector.Rd | 59 - man/cdisc_data.Rd | 29 +- man/cdisc_data_file.Rd | 8 +- man/relational_data_connector.Rd | 2 +- man/teal_data.Rd | 2 +- man/update_join_keys_to_primary.Rd | 17 + tests/testthat/test-CDISCTealData.R | 1205 -------------------- tests/testthat/test-JoinKeys.R | 110 +- tests/testthat/test-TealData.R | 830 ++++++-------- tests/testthat/test-TealDataAbstract.R | 580 ++++++++++ tests/testthat/test-TealDataset.R | 79 -- tests/testthat/test-TealDatasetConnector.R | 106 -- tests/testthat/test-cdisc_data.R | 279 +++++ tests/testthat/test-data_label.R | 12 + tests/testthat/test-teal_data.R | 215 +++- 34 files changed, 2073 insertions(+), 2655 deletions(-) delete mode 100644 R/CDISCTealData.R create mode 100644 R/cdisc_data.R delete mode 100644 man/CDISCTealData.Rd create mode 100644 man/update_join_keys_to_primary.Rd delete mode 100644 tests/testthat/test-CDISCTealData.R create mode 100644 tests/testthat/test-cdisc_data.R diff --git a/NEWS.md b/NEWS.md index 259a99dd7..84ae3240d 100644 --- a/NEWS.md +++ b/NEWS.md @@ -7,6 +7,10 @@ * Improved error message in `get_cdisc_keys`. * Fixed help files for `TealDataset` and `MAETealDataset`. * Added backstop for missing `reticulate` package in _teal.data with Python_ vignette. +* Removed `CDISCTealData` class and updated `TealData` to account for the removed functionality. +* Added datasets parents information to `JoinKeys` class. +* Updated `cdisc_data` and `teal_data` wrappers to handle join_keys creation and updating instead of `CDISCTealData` and `TealData`. +* Removed join_keys methods from `TealDataset`, `TealDatasetConnector`. # teal.data 0.1.2 diff --git a/R/CDISCTealData.R b/R/CDISCTealData.R deleted file mode 100644 index 802c16355..000000000 --- a/R/CDISCTealData.R +++ /dev/null @@ -1,270 +0,0 @@ -## CDISCTealData ==== -#' -#' @title Manage multiple `CDISCTealDataConnector`, `CDISCTealDatasetConnector` and `CDISCTealDataset` objects. -#' -#' @description `r lifecycle::badge("stable")` -#' Class manages `CDISCTealDataConnector`, `CDISCTealDatasetConnector` and -#' `CDISCTealDataset` objects and aggregate them in one collection. -#' -#' @param ... (`TealDataConnector`, `TealDataset` or -#' `TealDatasetConnector`) elements to include where `ADSL` data is mandatory. -#' @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 -#' @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. -#' -CDISCTealData <- R6::R6Class( # nolint - classname = "CDISCTealData", - inherit = TealData, - - ## __Public Methods ==== - public = list( - #' @description - #' Create a new object of `CDISCTealData` class - initialize = function(..., check = FALSE, join_keys) { - dot_args <- list(...) - - super$initialize(..., check = check, join_keys = join_keys) - - new_parent <- list() - for (x in dot_args) { - if (inherits(x, "TealDataset") || inherits(x, "TealDatasetConnector")) { - x_dataname <- x$get_dataname() - new_parent[[x_dataname]] <- if (inherits(x, "CDISCTealDataset") || inherits(x, "CDISCTealDatasetConnector")) { - x$get_parent() - } else { - character(0L) - } - } else if (inherits(x, "TealDataConnector")) { - added_parent <- if (inherits(x, "CDISCTealDataConnector")) { - x$get_parent() - } else { - sapply(x$get_datanames(), function(i) character(0), USE.NAMES = TRUE, simplify = FALSE) - } - new_parent <- c(new_parent, added_parent) - } else { - stop(paste( - "The child elements of CDISCTealData should be only of TealDataset or TealDatasetConnector or", - "TealDataConnector class." - )) - } - } - - if (is_dag(new_parent)) { - stop("Cycle detected in a parent and child dataset graph.") - } - - private$parent <- new_parent - - # for performance, get_join_keys should be called once outside of any loop - join_keys <- self$get_join_keys() - - # set up join keys as parent keys - datanames <- self$get_datanames() - duplicate_pairs <- list() - for (d1 in datanames) { - d1_pk <- get_keys(self$get_items(d1)) - d1_parent <- self$get_parent()[[d1]] - for (d2 in datanames) { - if (paste(d2, d1) %in% duplicate_pairs) { - next - } - if (length(join_keys$get(d1, d2)) == 0) { - d2_parent <- self$get_parent()[[d2]] - d2_pk <- get_keys(self$get_items(d2)) - - fk <- if (identical(d1, d2_parent)) { - # first is parent of second -> parent keys -> first keys - d1_pk - } else if (identical(d1_parent, d2)) { - # second is parent of first -> parent keys -> second keys - d2_pk - } else if (identical(d1_parent, d2_parent) && length(d1_parent) > 0) { - # both has the same parent -> parent keys - get_keys(self$get_items(d1_parent)) - } else { - # cant find connection - leave empty - next - } - - self$mutate_join_keys(d1, d2, fk) - duplicate_pairs <- append(duplicate_pairs, paste(d1, d2)) - } - } - } - - logger::log_trace("CDISCTealData 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 - }, - - # ___ check ==== - #' @description - #' Check correctness of stored joining keys and presence of keys to parent - #' @return raise and error or invisible `TRUE` - check_metadata = function() { - logger::log_trace("CDISCTealData$check_metadata checking metadata...") - if (!("ADSL" %in% self$get_datanames())) { - stop("ADSL dataset is missing.") - } - - super$check_metadata() - # for performance, get_join_keys should be called once outside of any loop - join_keys <- self$get_join_keys() - for (idx1 in seq_along(private$parent)) { - name_from <- names(private$parent)[[idx1]] - for (idx2 in seq_along(private$parent[[idx1]])) { - name_to <- private$parent[[idx1]][[idx2]] - keys_from <- join_keys$get(name_from, name_to) - keys_to <- join_keys$get(name_to, name_from) - - if (length(keys_from) == 0 && length(keys_to) == 0) { - stop(sprintf("No join keys from %s to its parent (%s) and vice versa", name_from, name_to)) - } - if (length(keys_from) == 0) { - stop(sprintf("No join keys from %s to its parent (%s)", name_from, name_to)) - } - if (length(keys_to) == 0) { - stop(sprintf("No join keys from %s parent name (%s) to %s", name_from, name_to, name_from)) - } - } - } - logger::log_trace("CDISCTealData$check_metadata metadata check passed.") - - return(invisible(TRUE)) - } - ), - - ## __Private Fields ==== - private = list( - parent = list() # list with dataset names and its parent dataset names - ) -) - -# CONSTRUCTORS ==== -#' Data input for teal app -#' -#' @description `r lifecycle::badge("stable")` -#' Function takes datasets and creates `CDISCTealData` object which can be used in `teal` applications. -#' -#' @note This function does not automatically assign keys to `TealDataset` -#' and `TealDatasetConnector` objects passed to it. If the keys are needed -#' they should be assigned before calling `cdisc_data`. See example: -#' ``` -# library(scda) -# test_dataset <- dataset("ADAE", synthetic_cdisc_data("latest")$adae) # does not have keys -# test_adsl <- cdisc_dataset("ADSL", synthetic_cdisc_data("latest")$adsl) -# test_data <- cdisc_data(test_dataset, test_adsl) -# get_keys(test_data, "ADAE") # returns character(0) -# -# test_dataset <- cdisc_dataset("ADAE", synthetic_cdisc_data("latest")$adae) -# test_data <- cdisc_data(test_dataset, test_adsl) -# get_keys(test_data, "ADAE") # returns [1] "STUDYID" "USUBJID" "ASTDTM" "AETERM" "AESEQ" -#' ``` -#' @inheritParams teal_data -#' @param ... (`TealDataConnector`, `TealDataset` or -#' `TealDatasetConnector`) elements to include where `ADSL` data is mandatory. -#' @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 -#' -#' @return a `CDISCTealData` object -#' -#' @details This function checks if there were keys added to all data sets -#' -#' @export -#' -#' @examples -#' library(scda) -#' -#' latest_data <- synthetic_cdisc_data("latest") -#' ADSL <- latest_data$adsl -#' ADTTE <- latest_data$adtte -#' -#' # basic example -#' cdisc_data( -#' cdisc_dataset("ADSL", ADSL), -#' cdisc_dataset("ADTTE", ADTTE), -#' code = 'ADSL <- synthetic_cdisc_data("latest")$adsl -#' ADTTE <- synthetic_cdisc_data("latest")$adtte', -#' check = TRUE -#' ) -#' -#' # Example with keys -#' cdisc_data( -#' cdisc_dataset("ADSL", ADSL, -#' keys = c("STUDYID", "USUBJID") -#' ), -#' cdisc_dataset("ADTTE", ADTTE, -#' keys = c("STUDYID", "USUBJID", "PARAMCD"), -#' parent = "ADSL" -#' ), -#' join_keys = join_keys( -#' join_key( -#' "ADSL", -#' "ADTTE", -#' c("STUDYID" = "STUDYID", "USUBJID" = "USUBJID") -#' ) -#' ), -#' code = 'ADSL <- synthetic_cdisc_data("latest")$adsl -#' ADTTE <- synthetic_cdisc_data("latest")$adtte', -#' check = TRUE -#' ) -cdisc_data <- function(..., - join_keys, - code = "", - check = FALSE) { - x <- CDISCTealData$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 `CDISCTealData` object from a file -#' -#' @description `r lifecycle::badge("experimental")` -#' -#' @inheritParams teal_data_file -#' -#' @return `CDISCTealData` 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 -#' ) -#' # parent keys -> first keys + d1_pk + } else if (identical(d1_parent, d2)) { + # second is parent of first -> parent keys -> second keys + d2_pk + } else if (identical(d1_parent, d2_parent) && length(d1_parent) > 0) { + # both has the same parent -> parent keys + self$get(d1_parent, d1_parent) + } else { + # cant find connection - leave empty + next + } + self$mutate(d1, d2, fk) + duplicate_pairs <- append(duplicate_pairs, paste(d1, d2)) + } + } + } + # check parent child relation + private$check_parent_child() + invisible(self) } ), ## __Private Fields ==== private = list( .keys = list(), + parents = list(), join_pair = function(join_key) { dataset_1 <- join_key$dataset_1 dataset_2 <- join_key$dataset_2 @@ -213,7 +293,6 @@ JoinKeys <- R6::R6Class( # nolint # and the first dataset of join_key_2 must match second dataset of join_key_1 # and keys must contain the same elements but with names and values swapped if (join_key_1$dataset_1 == join_key_2$dataset_2 && join_key_1$dataset_2 == join_key_2$dataset_1) { - # have to handle empty case differently as names(character(0)) is NULL if (length(join_key_1$keys) == 0 && length(join_key_2$keys) == 0) { return(TRUE) @@ -227,6 +306,29 @@ JoinKeys <- R6::R6Class( # nolint # otherwise they are compatible return(TRUE) + }, + # checks the parent child relations are valid + check_parent_child = function() { + if (!is.null(self$get_parents())) { + parents <- self$get_parents() + for (idx1 in seq_along(parents)) { + name_from <- names(parents)[[idx1]] + for (idx2 in seq_along(parents[[idx1]])) { + name_to <- parents[[idx1]][[idx2]] + keys_from <- self$get(name_from, name_to) + keys_to <- self$get(name_to, name_from) + if (length(keys_from) == 0 && length(keys_to) == 0) { + stop(sprintf("No join keys from %s to its parent (%s) and vice versa", name_from, name_to)) + } + if (length(keys_from) == 0) { + stop(sprintf("No join keys from %s to its parent (%s)", name_from, name_to)) + } + if (length(keys_to) == 0) { + stop(sprintf("No join keys from %s parent name (%s) to %s", name_from, name_to, name_from)) + } + } + } + } } ) ) @@ -256,14 +358,15 @@ JoinKeys <- R6::R6Class( # nolint #' ) join_keys <- function(...) { x <- list(...) + res <- JoinKeys$new() if (length(x) > 0) { res$set(x) } + res } - # wrappers ==== #' Mutate `JoinKeys` with a new values #' diff --git a/R/TealData.R b/R/TealData.R index 36d85d441..eede288e3 100644 --- a/R/TealData.R +++ b/R/TealData.R @@ -10,7 +10,7 @@ #' objects #' @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 +#' 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. #' @@ -61,7 +61,9 @@ TealData <- R6::R6Class( # nolint public = list( #' @description #' Create a new object of `TealData` class - initialize = function(..., check = FALSE, join_keys) { + 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, @@ -81,36 +83,8 @@ TealData <- R6::R6Class( # nolint private$pull_code <- CodeClass$new() private$mutate_code <- CodeClass$new() - if (missing(join_keys)) { - join_keys <- teal.data::join_keys() - } else if (inherits(join_keys, "JoinKeySet")) { - join_keys <- teal.data::join_keys(join_keys) - } - checkmate::assert_class(join_keys, "JoinKeys") - - duplicate_pairs <- list() - for (i in seq_along(join_keys$get())) { - # setting A->B and B->A is a duplicate as mutate_join_keys sets keys mutually - for (j in seq(i, length(join_keys$get()))) { - dataset_1 <- names(join_keys$get())[[i]] - dataset_2 <- names(join_keys$get())[[j]] - - if (paste(dataset_2, dataset_1) %in% duplicate_pairs) { - next - } + private$join_keys <- join_keys - keys <- join_keys$get()[[dataset_1]][[dataset_2]] - if (!is.null(keys)) { - self$mutate_join_keys(dataset_1, dataset_2, keys) - duplicate_pairs <- append(duplicate_pairs, paste(dataset_1, dataset_2)) - } - } - } - for (dat_name in names(self$get_items())) { - if (length(join_keys$get(dat_name, dat_name)) == 0) { - self$mutate_join_keys(dat_name, dat_name, get_keys(self$get_items(dat_name))) - } - } self$id <- sample.int(1e11, 1, useHash = TRUE) logger::log_trace( @@ -153,33 +127,6 @@ TealData <- R6::R6Class( # nolint }, # ___ getters ==== #' @description - #' - #' Derive the names of all datasets - #' @return (`character` vector) with names - get_datanames = function() { - datasets_names <- unlist(lapply(private$datasets, get_dataname)) - - return(datasets_names) - }, - #' @description - #' Get `JoinKeys` object with keys used for joining. - #' @return (`JoinKeys`) - get_join_keys = function() { - res <- join_keys() - duplicate_pairs <- list() - for (dat_obj in self$get_items()) { - list_keys <- dat_obj$get_join_keys()$get()[[1]] - for (dat_name in names(list_keys)) { - if (paste(dat_name, dat_obj$get_dataname()) %in% duplicate_pairs) { - next - } - res$mutate(dat_obj$get_dataname(), dat_name, list_keys[[dat_name]]) - duplicate_pairs <- append(duplicate_pairs, paste(dat_obj$get_dataname(), dat_name)) - } - } - return(res) - }, - #' @description #' Get data connectors. #' #' @return (`list`) with all `TealDatasetConnector` or `TealDataConnector` objects. @@ -222,6 +169,30 @@ TealData <- R6::R6Class( # nolint } }, + #' @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 @@ -324,34 +295,7 @@ TealData <- R6::R6Class( # nolint #' @param val (named `character`) column names used to join #' @return (`self`) invisibly for chaining mutate_join_keys = function(dataset_1, dataset_2, val) { - checkmate::assert_string(dataset_1) - checkmate::assert_string(dataset_2) - - if (!dataset_1 %in% names(self$get_items())) { - stop(sprintf("%s is not a name to any dataset stored in object.", dataset_1)) - } - if (!dataset_2 %in% names(self$get_items())) { - stop(sprintf("%s is not a name to any dataset stored in object.", dataset_2)) - } - - data_obj_1 <- self$get_items()[[dataset_1]] - data_obj_1$mutate_join_keys(dataset_2, val) - - if (dataset_1 != dataset_2) { - data_obj_2 <- self$get_items()[[dataset_2]] - contrary_keys <- if (!is.null(names(val))) { - # swap names with values to obtain data1 <- data2 relation - setNames(names(val), unname(val)) - } else { - setNames(val, val) - } - data_obj_2$mutate_join_keys(dataset_1, contrary_keys) - } - - logger::log_trace( - "TealData$mutate_join_keys modified the join keys between { dataset_1 } and { dataset_2 }" - ) - return(invisible(self)) + private$join_keys$mutate(dataset_1, dataset_2, val) }, # ___ check ==== @@ -364,15 +308,12 @@ TealData <- R6::R6Class( # nolint return(invisible(TRUE)) } - # for performance, get_join_keys should be called once outside of any loop - join_keys <- self$get_join_keys() - 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(join_keys$get(dataname), names))) + 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( @@ -385,7 +326,7 @@ TealData <- R6::R6Class( # nolint } # check if primary keys in dataset - primary_key_cols <- get_keys(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( @@ -398,6 +339,7 @@ TealData <- R6::R6Class( # nolint } dataset$check_keys() } + logger::log_trace("TealData$check_metadata metadata check passed.") return(invisible(TRUE)) @@ -406,6 +348,7 @@ TealData <- R6::R6Class( # nolint ## __Private Fields ==== private = list( + join_keys = NULL, ui = function(id) { ns <- NS(id) diff --git a/R/TealDataAbstract.R b/R/TealDataAbstract.R index 002bf04df..18f905dfd 100644 --- a/R/TealDataAbstract.R +++ b/R/TealDataAbstract.R @@ -81,7 +81,6 @@ TealDataAbstract <- R6::R6Class( # nolint 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))) @@ -165,7 +164,9 @@ TealDataAbstract <- R6::R6Class( # nolint #' #' @return `character` vector with names of all datasets. get_datanames = function() { - vapply(private$datasets, get_dataname, character(1)) + datasets_names <- unname(unlist(lapply(private$datasets, get_dataname))) + + return(datasets_names) }, #' @description #' Get `TealDataset` object. @@ -443,7 +444,7 @@ TealDataAbstract <- R6::R6Class( # nolint res$append(private$pull_code) return(res) }, - set_mutate_code = function(code, dataname = self$get_datanames(), deps = names(private_mutate_vars)) { + 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") diff --git a/R/TealDataConnector.R b/R/TealDataConnector.R index d8066be54..f67550eac 100644 --- a/R/TealDataConnector.R +++ b/R/TealDataConnector.R @@ -69,7 +69,7 @@ #' connection$get_open_server()(id = "open_connection", connection = connection) #' if (connection$is_opened()) { #' for (connector in connectors) { -#' set_args(connector, args = list(name = input$name)) +#' set_args(connector, args = list(archive_name = input$name)) #' # pull each dataset #' connector$get_server()(id = connector$get_dataname()) #' if (connector$is_failed()) { @@ -544,7 +544,7 @@ TealDataConnector <- R6::R6Class( # nolint #' connection$get_open_server()(id = "open_connection", connection = connection) #' if (connection$is_opened()) { #' for (connector in connectors) { -#' set_args(connector, args = list(name = input$name)) +#' set_args(connector, args = list(archive_name = input$name)) #' # pull each dataset #' connector$get_server()(id = connector$get_dataname()) #' if (connector$is_failed()) { diff --git a/R/TealDataset.R b/R/TealDataset.R index 780c0ec78..d39be8b19 100644 --- a/R/TealDataset.R +++ b/R/TealDataset.R @@ -241,15 +241,6 @@ TealDataset <- R6::R6Class( # nolint private$metadata }, #' @description - #' Get `JoinKeys` object with keys used for joining. - #' @return (`JoinKeys`) - get_join_keys = function() { - if (is.null(private$join_keys)) { - private$join_keys <- join_keys() - } - private$join_keys - }, - #' @description #' Get the list of dependencies that are `TealDataset` or `TealDatasetConnector` objects #' #' @return `list` @@ -324,41 +315,7 @@ TealDataset <- R6::R6Class( # nolint )) return(invisible(self)) }, - #' @description - #' set join_keys for a given dataset and object - #' @param x `list` of `JoinKeySet` objects (which are created using the `join_key` function) - #' or single `JoinKeySet` objects - #' @return (`self`) invisibly for chaining - set_join_keys = function(x) { - self$get_join_keys()$set(x) - logger::log_trace("TealDataset$set_join_keys join_keys set for dataset: { deparse1(self$get_dataname()) }.") - return(invisible(self)) - }, - #' @description - #' merge input join key with join key inside of object - #' @param x `list` of `JoinKeys` objects or single `JoinKeys` object - #' @return (`self`) invisibly for chaining - merge_join_keys = function(x) { - self$get_join_keys()$merge(x) - logger::log_trace("TealDataset$merge_join_keys join_keys merged for dataset: { deparse1(self$get_dataname()) }.") - return(invisible(self)) - }, - #' @description - #' mutate the join_keys for a given dataset and object - #' @param dataset (`character`) dataset for which join_keys are to be set against self - #' @param val (named `character`) column names used to join - #' @return (`self`) invisibly for chaining - mutate_join_keys = function(dataset, val) { - self$get_join_keys()$mutate(private$dataname, dataset, val) - logger::log_trace( - paste0( - "TealDatasetConnector$mutate_join_keys join_keys modified keys", - "of { deparse1(self$get_dataname()) } against { dataset }." - ) - ) - return(invisible(self)) - }, #' @description #' Adds variables which code depends on #' @@ -593,7 +550,6 @@ TealDataset <- R6::R6Class( # nolint .keys = character(0), mutate_code = list(), mutate_vars = list(), - join_keys = NULL, ## __Private Methods ==== mutate_delayed = function(code, vars) { diff --git a/R/TealDatasetConnector.R b/R/TealDatasetConnector.R index d970e3973..256ff980f 100644 --- a/R/TealDatasetConnector.R +++ b/R/TealDatasetConnector.R @@ -134,16 +134,6 @@ TealDatasetConnector <- R6::R6Class( # nolint get_keys = function() { return(private$keys) }, - #' @description - #' Get `JoinKeys` object with keys used for joining. - #' @return (`JoinKeys`) - get_join_keys = function() { - if (is.null(private$join_keys)) { - private$join_keys <- join_keys() - } - private$join_keys - }, - #' @description #' Get code to get data #' @@ -189,7 +179,6 @@ TealDatasetConnector <- R6::R6Class( # nolint call. = FALSE ) } - private$dataset$merge_join_keys(self$get_join_keys()) private$dataset$get_dataset() return(private$dataset) }, @@ -285,35 +274,6 @@ TealDatasetConnector <- R6::R6Class( # nolint return(invisible(self)) }, - #' @description - #' set join_keys for a given dataset and self - #' @param x `list` of `JoinKeySet` objects (which are created using the `join_key` function) - #' or single `JoinKeySet` objects - #' @return (`self`) invisibly for chaining - set_join_keys = function(x) { - self$get_join_keys()$set(x) - logger::log_trace(paste( - "TealDatasetConnector$set_join_keys join_keys set for dataset:", - "{ deparse1(self$get_dataname()) }." - )) - - return(invisible(self)) - }, - - #' @description - #' mutate the join_keys for a given dataset and self - #' @param dataset (`character`) dataset for which join_keys are to be set against self - #' @param val (named `character`) column names used to join - #' @return (`self`) invisibly for chaining - mutate_join_keys = function(dataset, val) { - self$get_join_keys()$mutate(private$dataname, dataset, val) - logger::log_trace( - "TealDatasetConnector$mutate_join_keys join_keys modified keys of - { deparse1(self$get_dataname()) } against { dataset }." - ) - - return(invisible(self)) - }, # ___ pull ==== #' @description @@ -547,7 +507,6 @@ TealDatasetConnector <- R6::R6Class( # nolint var_r6 = list(), ui_input = NULL, # NULL or list is_pulled_flag = FALSE, - join_keys = NULL, ## __Private Methods ==== ui = function(id) { diff --git a/R/cdisc_data.R b/R/cdisc_data.R new file mode 100644 index 000000000..e97e0723c --- /dev/null +++ b/R/cdisc_data.R @@ -0,0 +1,165 @@ +#' Data input for teal app +#' +#' @description `r lifecycle::badge("stable")` +#' Function takes datasets and creates `TealData` object which can be used in `teal` applications. +#' +#' @note This function does not automatically assign keys to `TealDataset` +#' and `TealDatasetConnector` objects passed to it. If the keys are needed +#' they should be assigned before calling `cdisc_data`. See example: +#' ``` +#' library(scda) +#' test_dataset <- dataset("ADAE", synthetic_cdisc_data("latest")$adae) # does not have keys +#' test_adsl <- cdisc_dataset("ADSL", synthetic_cdisc_data("latest")$adsl) +#' test_data <- cdisc_data(test_dataset, test_adsl) +#' get_keys(test_data, "ADAE") # returns character(0) +#' +#' test_dataset <- cdisc_dataset("ADAE", synthetic_cdisc_data("latest")$adae) +#' test_data <- cdisc_data(test_dataset, test_adsl) +#' get_keys(test_data, "ADAE") # returns [1] "STUDYID" "USUBJID" "ASTDTM" "AETERM" "AESEQ" +#' ``` +#' @inheritParams teal_data +#' @param ... (`TealDataConnector`, `TealDataset` or +#' `TealDatasetConnector`) elements to include. +#' @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 +#' +#' @return a `TealData` object +#' +#' @details This function checks if there were keys added to all data sets +#' +#' @export +#' +#' @examples +#' library(scda) +#' +#' latest_data <- synthetic_cdisc_data("latest") +#' ADSL <- latest_data$adsl +#' ADTTE <- latest_data$adtte +#' +#' # basic example +#' cdisc_data( +#' cdisc_dataset("ADSL", ADSL), +#' cdisc_dataset("ADTTE", ADTTE), +#' code = "ADSL <- synthetic_cdisc_data('latest')$adsl +#' ADTTE <- synthetic_cdisc_data('latest')$adtte", +#' check = TRUE +#' ) +#' +#' # Example with keys +#' cdisc_data( +#' cdisc_dataset("ADSL", ADSL, +#' keys = c("STUDYID", "USUBJID") +#' ), +#' cdisc_dataset("ADTTE", ADTTE, +#' keys = c("STUDYID", "USUBJID", "PARAMCD"), +#' parent = "ADSL" +#' ), +#' join_keys = join_keys( +#' join_key( +#' "ADSL", +#' "ADTTE", +#' c("STUDYID" = "STUDYID", "USUBJID" = "USUBJID") +#' ) +#' ), +#' code = "ADSL <- synthetic_cdisc_data('latest')$adsl +#' ADTTE <- synthetic_cdisc_data('latest')$adtte", +#' check = TRUE +#' ) +cdisc_data <- function(..., + join_keys = teal.data::join_keys(), + 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 +#' ) +#' # 0 && !identical(code, "")) { x$set_pull_code(code = code) } @@ -102,3 +99,26 @@ teal_data_file <- function(path, code = get_code(path)) { 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/_pkgdown.yml b/_pkgdown.yml index c9637fddc..95e2cc07d 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -10,18 +10,18 @@ navbar: href: https://github.com/insightsengineering/teal.data articles: -- title: Articles - navbar: ~ - contents: - - teal-data - - preprocessing-data - - preprocessing-delayed-data - - reproducibility - - join-keys - - using-delayed-data-basic - - using-delayed-data-advanced - - testing-delayed-data - - teal.data-with-python + - title: Articles + navbar: ~ + contents: + - teal-data + - preprocessing-data + - preprocessing-delayed-data + - reproducibility + - join-keys + - using-delayed-data-basic + - using-delayed-data-advanced + - testing-delayed-data + - teal.data-with-python reference: - title: Delayed Dataset Constructors @@ -107,7 +107,6 @@ reference: contents: - CallableCode - CallablePythonCode - - CDISCTealData - CDISCTealDataConnector - CDISCTealDataset - CDISCTealDatasetConnector diff --git a/man/CDISCTealData.Rd b/man/CDISCTealData.Rd deleted file mode 100644 index 49769bbb7..000000000 --- a/man/CDISCTealData.Rd +++ /dev/null @@ -1,122 +0,0 @@ -% Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealData.R -\name{CDISCTealData} -\alias{CDISCTealData} -\title{Manage multiple \code{CDISCTealDataConnector}, \code{CDISCTealDatasetConnector} and \code{CDISCTealDataset} objects.} -\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{CDISCTealDataConnector}, \code{CDISCTealDatasetConnector} and -\code{CDISCTealDataset} objects and aggregate them in one collection. -} -\section{Super classes}{ -\code{\link[teal.data:TealDataAbstract]{teal.data::TealDataAbstract}} -> \code{\link[teal.data:TealData]{teal.data::TealData}} -> \code{CDISCTealData} -} -\section{Methods}{ -\subsection{Public methods}{ -\itemize{ -\item \href{#method-CDISCTealData-new}{\code{CDISCTealData$new()}} -\item \href{#method-CDISCTealData-get_parent}{\code{CDISCTealData$get_parent()}} -\item \href{#method-CDISCTealData-check_metadata}{\code{CDISCTealData$check_metadata()}} -\item \href{#method-CDISCTealData-clone}{\code{CDISCTealData$clone()}} -} -} -\if{html}{\out{ -
Inherited methods - -
-}} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealData-new}{}}} -\subsection{Method \code{new()}}{ -Create a new object of \code{CDISCTealData} class -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealData$new(..., check = FALSE, join_keys)}\if{html}{\out{
}} -} - -\subsection{Arguments}{ -\if{html}{\out{
}} -\describe{ -\item{\code{...}}{(\code{TealDataConnector}, \code{TealDataset} or -\code{TealDatasetConnector}) elements to include where \code{ADSL} data is mandatory.} - -\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 datasets column names used for joining. -If empty then it would be automatically derived basing on intersection of datasets primary keys} -} -\if{html}{\out{
}} -} -} -\if{html}{\out{
}} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-CDISCTealData-get_parent}{}}} -\subsection{Method \code{get_parent()}}{ -Get all datasets parent names -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealData$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-CDISCTealData-check_metadata}{}}} -\subsection{Method \code{check_metadata()}}{ -Check correctness of stored joining keys and presence of keys to parent -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealData$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-CDISCTealData-clone}{}}} -\subsection{Method \code{clone()}}{ -The objects of this class are cloneable with this method. -\subsection{Usage}{ -\if{html}{\out{
}}\preformatted{CDISCTealData$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 index b7c02119b..e2d7b7f89 100644 --- a/man/CDISCTealDataset.Rd +++ b/man/CDISCTealDataset.Rd @@ -57,7 +57,6 @@ x$get_parent()
  • teal.data::TealDataset$get_dataset()
  • teal.data::TealDataset$get_dataset_label()
  • teal.data::TealDataset$get_factor_colnames()
    • -
  • teal.data::TealDataset$get_join_keys()
  • teal.data::TealDataset$get_keys()
  • teal.data::TealDataset$get_metadata()
  • teal.data::TealDataset$get_mutate_code_class()
    • @@ -72,14 +71,11 @@ x$get_parent()
  • teal.data::TealDataset$get_vars()
  • teal.data::TealDataset$is_mutate_delayed()
  • teal.data::TealDataset$is_pulled()
    • -
  • teal.data::TealDataset$merge_join_keys()
  • teal.data::TealDataset$mutate()
    • -
  • teal.data::TealDataset$mutate_join_keys()
  • teal.data::TealDataset$print()
  • teal.data::TealDataset$reassign_datasets_vars()
  • teal.data::TealDataset$set_code()
  • teal.data::TealDataset$set_dataset_label()
    • -
  • teal.data::TealDataset$set_join_keys()
  • teal.data::TealDataset$set_keys()
  • teal.data::TealDataset$set_vars()
    • diff --git a/man/CDISCTealDatasetConnector.Rd b/man/CDISCTealDatasetConnector.Rd index 0af50a7d6..e33763542 100644 --- a/man/CDISCTealDatasetConnector.Rd +++ b/man/CDISCTealDatasetConnector.Rd @@ -34,7 +34,6 @@ be empty (i.e. \code{character(0)}).
  • teal.data::TealDatasetConnector$get_dataset()
  • teal.data::TealDatasetConnector$get_dataset_label()
  • teal.data::TealDatasetConnector$get_error_message()
    • -
  • teal.data::TealDatasetConnector$get_join_keys()
  • teal.data::TealDatasetConnector$get_keys()
  • teal.data::TealDatasetConnector$get_pull_args()
  • teal.data::TealDatasetConnector$get_pull_callable()
    • @@ -47,12 +46,10 @@ be empty (i.e. \code{character(0)}).
  • teal.data::TealDatasetConnector$is_pulled()
  • teal.data::TealDatasetConnector$launch()
  • teal.data::TealDatasetConnector$mutate()
    • -
  • teal.data::TealDatasetConnector$mutate_join_keys()
  • teal.data::TealDatasetConnector$print()
  • teal.data::TealDatasetConnector$reassign_datasets_vars()
  • teal.data::TealDatasetConnector$set_args()
  • teal.data::TealDatasetConnector$set_dataset_label()
    • -
  • teal.data::TealDatasetConnector$set_join_keys()
  • teal.data::TealDatasetConnector$set_keys()
  • teal.data::TealDatasetConnector$set_ui_input()
    • diff --git a/man/JoinKeys.Rd b/man/JoinKeys.Rd index 99cc10124..978b19bef 100644 --- a/man/JoinKeys.Rd +++ b/man/JoinKeys.Rd @@ -32,6 +32,10 @@ x$get("dataset_A", "dataset_B") \item \href{#method-JoinKeys-mutate}{\code{JoinKeys$mutate()}} \item \href{#method-JoinKeys-set}{\code{JoinKeys$set()}} \item \href{#method-JoinKeys-print}{\code{JoinKeys$print()}} +\item \href{#method-JoinKeys-set_parents}{\code{JoinKeys$set_parents()}} +\item \href{#method-JoinKeys-get_parent}{\code{JoinKeys$get_parent()}} +\item \href{#method-JoinKeys-get_parents}{\code{JoinKeys$get_parents()}} +\item \href{#method-JoinKeys-update_keys_given_parents}{\code{JoinKeys$update_keys_given_parents()}} \item \href{#method-JoinKeys-clone}{\code{JoinKeys$clone()}} } } @@ -182,6 +186,72 @@ invisibly self } } \if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-JoinKeys-set_parents}{}}} +\subsection{Method \code{set_parents()}}{ +Sets the parents of the datasets. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{JoinKeys$set_parents(named_list)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{named_list}}{Named (\code{list}) of the parents datasets.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +(\code{self}) invisibly for chaining +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-JoinKeys-get_parent}{}}} +\subsection{Method \code{get_parent()}}{ +Gets the parent of the desired dataset. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{JoinKeys$get_parent(dataname)}\if{html}{\out{
    }} +} + +\subsection{Arguments}{ +\if{html}{\out{
    }} +\describe{ +\item{\code{dataname}}{(\code{character}) name of the dataset.} +} +\if{html}{\out{
    }} +} +\subsection{Returns}{ +(\code{character}) the parent of the desired dataset +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-JoinKeys-get_parents}{}}} +\subsection{Method \code{get_parents()}}{ +Gets the parents of the datasets. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{JoinKeys$get_parents()}\if{html}{\out{
    }} +} + +\subsection{Returns}{ +(\code{list}) A named list of the parents of all datasets +} +} +\if{html}{\out{
    }} +\if{html}{\out{}} +\if{latex}{\out{\hypertarget{method-JoinKeys-update_keys_given_parents}{}}} +\subsection{Method \code{update_keys_given_parents()}}{ +Updates the keys of the datasets based on the parents. +\subsection{Usage}{ +\if{html}{\out{
    }}\preformatted{JoinKeys$update_keys_given_parents()}\if{html}{\out{
    }} +} + +\subsection{Returns}{ +(\code{self}) invisibly for chaining +} +} +\if{html}{\out{
    }} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-JoinKeys-clone}{}}} \subsection{Method \code{clone()}}{ diff --git a/man/MAETealDataset.Rd b/man/MAETealDataset.Rd index b7348feee..9acd941fc 100644 --- a/man/MAETealDataset.Rd +++ b/man/MAETealDataset.Rd @@ -42,7 +42,6 @@ be automatically derived.
  • teal.data::TealDataset$get_dataset()
  • teal.data::TealDataset$get_dataset_label()
  • teal.data::TealDataset$get_factor_colnames()
    • -
  • teal.data::TealDataset$get_join_keys()
  • teal.data::TealDataset$get_keys()
  • teal.data::TealDataset$get_metadata()
  • teal.data::TealDataset$get_mutate_code_class()
    • @@ -54,14 +53,11 @@ be automatically derived.
  • teal.data::TealDataset$get_vars()
  • teal.data::TealDataset$is_mutate_delayed()
  • teal.data::TealDataset$is_pulled()
    • -
  • teal.data::TealDataset$merge_join_keys()
  • teal.data::TealDataset$mutate()
    • -
  • teal.data::TealDataset$mutate_join_keys()
  • teal.data::TealDataset$reassign_datasets_vars()
  • teal.data::TealDataset$recreate()
  • teal.data::TealDataset$set_code()
  • teal.data::TealDataset$set_dataset_label()
    • -
  • teal.data::TealDataset$set_join_keys()
  • teal.data::TealDataset$set_keys()
  • teal.data::TealDataset$set_vars()
    • diff --git a/man/TealData.Rd b/man/TealData.Rd index 248be211f..9801797f6 100644 --- a/man/TealData.Rd +++ b/man/TealData.Rd @@ -59,10 +59,10 @@ get_raw_data(tc) \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_datanames}{\code{TealData$get_datanames()}} -\item \href{#method-TealData-get_join_keys}{\code{TealData$get_join_keys()}} \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()}} @@ -81,6 +81,7 @@ get_raw_data(tc)
  • teal.data::TealDataAbstract$get_check_result()
  • teal.data::TealDataAbstract$get_code()
  • teal.data::TealDataAbstract$get_code_class()
    • +
  • teal.data::TealDataAbstract$get_datanames()
  • teal.data::TealDataAbstract$get_dataset()
  • teal.data::TealDataAbstract$get_datasets()
  • teal.data::TealDataAbstract$is_pulled()
    • @@ -98,7 +99,7 @@ get_raw_data(tc) \subsection{Method \code{new()}}{ Create a new object of \code{TealData} class \subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealData$new(..., check = FALSE, join_keys)}\if{html}{\out{
    }} +\if{html}{\out{
    }}\preformatted{TealData$new(..., check = FALSE, join_keys = teal.data::join_keys())}\if{html}{\out{
    }} } \subsection{Arguments}{ @@ -112,7 +113,7 @@ as provided in arguments. Check is run only if flag is true and preprocessing co \item{\code{join_keys}}{(\code{JoinKeys}) or a single (\code{JoinKeySet})\cr (optional) object with dataset column relationships used for joining. -If empty then no joins between pairs of objects} +If empty then an empty \code{JoinKeys} object is passed by default.} } \if{html}{\out{}} } @@ -160,32 +161,6 @@ invisibly self } } \if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_datanames}{}}} -\subsection{Method \code{get_datanames()}}{ -Derive the names of all datasets -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealData$get_datanames()}\if{html}{\out{
    }} -} - -\subsection{Returns}{ -(\code{character} vector) with names -} -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealData-get_join_keys}{}}} -\subsection{Method \code{get_join_keys()}}{ -Get \code{JoinKeys} object with keys used for joining. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealData$get_join_keys()}\if{html}{\out{
    }} -} - -\subsection{Returns}{ -(\code{JoinKeys}) -} -} -\if{html}{\out{
    }} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealData-get_connectors}{}}} \subsection{Method \code{get_connectors()}}{ @@ -220,6 +195,43 @@ name of dataset connector to be returned. If \code{NULL}, all connectors are ret } } \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()}}{ diff --git a/man/TealDataConnector.Rd b/man/TealDataConnector.Rd index 67880f3a1..f0cbd40f8 100644 --- a/man/TealDataConnector.Rd +++ b/man/TealDataConnector.Rd @@ -65,7 +65,7 @@ x$set_server( connection$get_open_server()(id = "open_connection", connection = connection) if (connection$is_opened()) { for (connector in connectors) { - set_args(connector, args = list(name = input$name)) + set_args(connector, args = list(archive_name = input$name)) # pull each dataset connector$get_server()(id = connector$get_dataname()) if (connector$is_failed()) { diff --git a/man/TealDataset.Rd b/man/TealDataset.Rd index 452b683e7..da61d22fa 100644 --- a/man/TealDataset.Rd +++ b/man/TealDataset.Rd @@ -62,14 +62,10 @@ test_dataset$reassign_datasets_vars( \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_join_keys}{\code{TealDataset$get_join_keys()}} \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_join_keys}{\code{TealDataset$set_join_keys()}} -\item \href{#method-TealDataset-merge_join_keys}{\code{TealDataset$merge_join_keys()}} -\item \href{#method-TealDataset-mutate_join_keys}{\code{TealDataset$mutate_join_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()}} @@ -436,19 +432,6 @@ Get metadata of dataset } } \if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-get_join_keys}{}}} -\subsection{Method \code{get_join_keys()}}{ -Get \code{JoinKeys} object with keys used for joining. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDataset$get_join_keys()}\if{html}{\out{
    }} -} - -\subsection{Returns}{ -(\code{JoinKeys}) -} -} -\if{html}{\out{
    }} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealDataset-get_var_r6}{}}} \subsection{Method \code{get_var_r6()}}{ @@ -550,69 +533,6 @@ Vector with primary keys} } } \if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-set_join_keys}{}}} -\subsection{Method \code{set_join_keys()}}{ -set join_keys for a given dataset and object -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDataset$set_join_keys(x)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{x}}{\code{list} of \code{JoinKeySet} objects (which are created using the \code{join_key} function) -or single \code{JoinKeySet} objects} -} -\if{html}{\out{
    }} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-merge_join_keys}{}}} -\subsection{Method \code{merge_join_keys()}}{ -merge input join key with join key inside of object -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDataset$merge_join_keys(x)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{x}}{\code{list} of \code{JoinKeys} objects or single \code{JoinKeys} object} -} -\if{html}{\out{
    }} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDataset-mutate_join_keys}{}}} -\subsection{Method \code{mutate_join_keys()}}{ -mutate the join_keys for a given dataset and object -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDataset$mutate_join_keys(dataset, val)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{dataset}}{(\code{character}) dataset for which join_keys are to be set against self} - -\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-TealDataset-set_vars}{}}} \subsection{Method \code{set_vars()}}{ diff --git a/man/TealDatasetConnector.Rd b/man/TealDatasetConnector.Rd index 0dd69469f..d3b0f473a 100644 --- a/man/TealDatasetConnector.Rd +++ b/man/TealDatasetConnector.Rd @@ -53,7 +53,6 @@ ds$launch() \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_join_keys}{\code{TealDatasetConnector$get_join_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()}} @@ -65,8 +64,6 @@ ds$launch() \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-set_join_keys}{\code{TealDatasetConnector$set_join_keys()}} -\item \href{#method-TealDatasetConnector-mutate_join_keys}{\code{TealDatasetConnector$mutate_join_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()}} @@ -213,19 +210,6 @@ Get primary keys of dataset } } \if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_join_keys}{}}} -\subsection{Method \code{get_join_keys()}}{ -Get \code{JoinKeys} object with keys used for joining. -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDatasetConnector$get_join_keys()}\if{html}{\out{
    }} -} - -\subsection{Returns}{ -(\code{JoinKeys}) -} -} -\if{html}{\out{
    }} \if{html}{\out{}} \if{latex}{\out{\hypertarget{method-TealDatasetConnector-get_code}{}}} \subsection{Method \code{get_code()}}{ @@ -404,49 +388,6 @@ vector of dataset primary keys column names} } } \if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-set_join_keys}{}}} -\subsection{Method \code{set_join_keys()}}{ -set join_keys for a given dataset and self -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDatasetConnector$set_join_keys(x)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{x}}{\code{list} of \code{JoinKeySet} objects (which are created using the \code{join_key} function) -or single \code{JoinKeySet} objects} -} -\if{html}{\out{
    }} -} -\subsection{Returns}{ -(\code{self}) invisibly for chaining -} -} -\if{html}{\out{
    }} -\if{html}{\out{}} -\if{latex}{\out{\hypertarget{method-TealDatasetConnector-mutate_join_keys}{}}} -\subsection{Method \code{mutate_join_keys()}}{ -mutate the join_keys for a given dataset and self -\subsection{Usage}{ -\if{html}{\out{
    }}\preformatted{TealDatasetConnector$mutate_join_keys(dataset, val)}\if{html}{\out{
    }} -} - -\subsection{Arguments}{ -\if{html}{\out{
    }} -\describe{ -\item{\code{dataset}}{(\code{character}) dataset for which join_keys are to be set against self} - -\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-TealDatasetConnector-pull}{}}} \subsection{Method \code{pull()}}{ diff --git a/man/cdisc_data.Rd b/man/cdisc_data.Rd index 0abd10bff..38839fd86 100644 --- a/man/cdisc_data.Rd +++ b/man/cdisc_data.Rd @@ -1,14 +1,14 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealData.R +% Please edit documentation in R/cdisc_data.R \name{cdisc_data} \alias{cdisc_data} \title{Data input for teal app} \usage{ -cdisc_data(..., join_keys, code = "", check = FALSE) +cdisc_data(..., join_keys = teal.data::join_keys(), code = "", check = FALSE) } \arguments{ \item{...}{(\code{TealDataConnector}, \code{TealDataset} or -\code{TealDatasetConnector}) elements to include where \code{ADSL} data is mandatory.} +\code{TealDatasetConnector}) elements to include.} \item{join_keys}{(\code{JoinKeys}) or a single (\code{JoinKeySet})\cr (optional) object with datasets column names used for joining. @@ -21,11 +21,11 @@ code included in the object definitions actually produces those objects. If \code{check} is true and preprocessing code is empty an error will be thrown.} } \value{ -a \code{CDISCTealData} object +a \code{TealData} object } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} -Function takes datasets and creates \code{CDISCTealData} object which can be used in \code{teal} applications. +Function takes datasets and creates \code{TealData} object which can be used in \code{teal} applications. } \details{ This function checks if there were keys added to all data sets @@ -35,7 +35,16 @@ This function does not automatically assign keys to \code{TealDataset} and \code{TealDatasetConnector} objects passed to it. If the keys are needed they should be assigned before calling \code{cdisc_data}. See example: -\if{html}{\out{
    }}\preformatted{}\if{html}{\out{
    }} +\if{html}{\out{
    }}\preformatted{library(scda) +test_dataset <- dataset("ADAE", synthetic_cdisc_data("latest")$adae) # does not have keys +test_adsl <- cdisc_dataset("ADSL", synthetic_cdisc_data("latest")$adsl) +test_data <- cdisc_data(test_dataset, test_adsl) +get_keys(test_data, "ADAE") # returns character(0) + +test_dataset <- cdisc_dataset("ADAE", synthetic_cdisc_data("latest")$adae) +test_data <- cdisc_data(test_dataset, test_adsl) +get_keys(test_data, "ADAE") # returns [1] "STUDYID" "USUBJID" "ASTDTM" "AETERM" "AESEQ" +}\if{html}{\out{
    }} } \examples{ library(scda) @@ -48,8 +57,8 @@ ADTTE <- latest_data$adtte cdisc_data( cdisc_dataset("ADSL", ADSL), cdisc_dataset("ADTTE", ADTTE), - code = 'ADSL <- synthetic_cdisc_data("latest")$adsl - ADTTE <- synthetic_cdisc_data("latest")$adtte', + code = "ADSL <- synthetic_cdisc_data('latest')$adsl + ADTTE <- synthetic_cdisc_data('latest')$adtte", check = TRUE ) @@ -69,8 +78,8 @@ cdisc_data( c("STUDYID" = "STUDYID", "USUBJID" = "USUBJID") ) ), - code = 'ADSL <- synthetic_cdisc_data("latest")$adsl - ADTTE <- synthetic_cdisc_data("latest")$adtte', + code = "ADSL <- synthetic_cdisc_data('latest')$adsl + ADTTE <- synthetic_cdisc_data('latest')$adtte", check = TRUE ) } diff --git a/man/cdisc_data_file.Rd b/man/cdisc_data_file.Rd index 2c770e895..045260a87 100644 --- a/man/cdisc_data_file.Rd +++ b/man/cdisc_data_file.Rd @@ -1,8 +1,8 @@ % Generated by roxygen2: do not edit by hand -% Please edit documentation in R/CDISCTealData.R +% Please edit documentation in R/cdisc_data.R \name{cdisc_data_file} \alias{cdisc_data_file} -\title{Load \code{CDISCTealData} object from a file} +\title{Load \code{TealData} object from a file} \usage{ cdisc_data_file(path, code = get_code(path)) } @@ -14,10 +14,10 @@ string giving the pathname of the file or URL to read from. "" indicates the con reproducible code to re-create object} } \value{ -\code{CDISCTealData} object +\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]}} +\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") diff --git a/man/relational_data_connector.Rd b/man/relational_data_connector.Rd index 848ea12f6..c865aa496 100644 --- a/man/relational_data_connector.Rd +++ b/man/relational_data_connector.Rd @@ -76,7 +76,7 @@ x$set_server( connection$get_open_server()(id = "open_connection", connection = connection) if (connection$is_opened()) { for (connector in connectors) { - set_args(connector, args = list(name = input$name)) + set_args(connector, args = list(archive_name = input$name)) # pull each dataset connector$get_server()(id = connector$get_dataname()) if (connector$is_failed()) { diff --git a/man/teal_data.Rd b/man/teal_data.Rd index 42a379697..9aa287038 100644 --- a/man/teal_data.Rd +++ b/man/teal_data.Rd @@ -4,7 +4,7 @@ \alias{teal_data} \title{Teal data} \usage{ -teal_data(..., join_keys, code = "", check = FALSE) +teal_data(..., join_keys = teal.data::join_keys(), code = "", check = FALSE) } \arguments{ \item{...}{(\code{TealDataConnector}, \code{TealDataset}, \code{TealDatasetConnector})\cr diff --git a/man/update_join_keys_to_primary.Rd b/man/update_join_keys_to_primary.Rd new file mode 100644 index 000000000..b6e977ce9 --- /dev/null +++ b/man/update_join_keys_to_primary.Rd @@ -0,0 +1,17 @@ +% 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/tests/testthat/test-CDISCTealData.R b/tests/testthat/test-CDISCTealData.R deleted file mode 100644 index 8fc485faa..000000000 --- a/tests/testthat/test-CDISCTealData.R +++ /dev/null @@ -1,1205 +0,0 @@ -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")))) -adae_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE")))) -adrs_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADRS")))) - -# 1. single dataset / dataset code ------------------------------- -testthat::test_that("single dataset / dataset code", { - adsl_dataset <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = "as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - testthat::expect_silent( - data <- cdisc_data(adsl_dataset, check = TRUE) - ) - - testthat::expect_true(adsl_dataset$check()) - testthat::expect_true(data$check()) - testthat::expect_identical(data$get_code(), "as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))") - testthat::expect_identical(data$get_code(), adsl_dataset$get_code()) - - # MUTATE - testthat::expect_silent( - data <- cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - check = TRUE - ) %>% mutate_data(code = "ADSL <- dplyr::filter(ADSL, USUBJID == 'F')") - ) - - testthat::expect_true(data$check()) - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"F\")", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - testthat::expect_identical( - data$get_code_class(FALSE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"F\")", - sep = "\n" - ) - ) - testthat::expect_reference( - data$get_dataset("ADSL")$get_raw_data(), - adsl_raw - ) - - testthat::expect_true(data$check()) - data$execute_mutate() - testthat::expect_false(data$check()) - data$check_metadata() - - new_env <- new.env() - eval(parse(text = data$get_code("ADSL"), keep.source = FALSE), envir = new_env) - testthat::expect_identical( - get(x = "ADSL", envir = new_env), - data$get_dataset("ADSL")$get_raw_data() - ) -}) - -# 2. two datasets / datasets code ------------------------------- -testthat::test_that("two datasets / datasets code", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - - adtte <- cdisc_dataset( - dataname = "ADTTE", - x = adtte_raw, - code = "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))" - ) - - testthat::expect_silent( - data <- cdisc_data(adsl, adtte, check = TRUE) - ) - - testthat::expect_true(adsl$check()) - testthat::expect_true(adtte$check()) - testthat::expect_true(data$check()) - - testthat::expect_identical( - adsl$get_code(), - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - testthat::expect_identical( - adtte$get_code(), - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))" - ) - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ) - ) - - # MUTATE - testthat::expect_silent( - data <- cdisc_data(adsl, adtte, check = TRUE) %>% - mutate_dataset(dataname = "ADSL", code = "ADSL <- dplyr::filter(ADSL, USUBJID == 'a')") %>% - mutate_dataset( - dataname = "ADTTE", - code = "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - vars = list(ADSL = adsl) - ) %>% - mutate_dataset(dataname = "ADSL", code = "ADSL$x <- 1") - ) - - testthat::expect_true(data$check()) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADSL"), - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADTTE"), - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))" - ) - - testthat::expect_identical( - data$get_code_class(FALSE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADSL$x <- 1", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - vapply( - list( - ADSL = data$get_dataset("ADSL")$get_raw_data(), - ADTTE = data$get_dataset("ADTTE")$get_raw_data() - ), - nrow, - numeric(1) - ), - c(ADSL = 3, ADTTE = 1) - ) - - data$execute_mutate() - testthat::expect_identical( - vapply( - list( - ADSL = data$get_dataset("ADSL")$get_raw_data(), - ADTTE = data$get_dataset("ADSL")$get_raw_data() - ), - nrow, - numeric(1) - ), - c(ADSL = 1, ADTTE = 1) - ) -}) - -testthat::test_that("Duplicated code from datasets is shown", { - some_var <- "TEST" - adsl_raw$test <- some_var - - adsl <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = " - ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\")))) - some_var <- 'TEST' - ADSL$test <- some_var" - ) - - adae <- cdisc_dataset( - dataname = "ADAE", - x = adae_raw, - code = " - ADAE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADAE\"))))" - ) - - data <- cdisc_data(adsl, adae) - - testthat::expect_equal( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "some_var <- \"TEST\"", - "ADSL$test <- some_var", - "ADAE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADAE\"))))", - sep = "\n" - ) - ) -}) - -# 3. two datasets / global code ------------------------------- -testthat::test_that("two datasets / datasets code", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - - adtte <- cdisc_dataset( - dataname = "ADTTE", - x = adtte_raw, - code = "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))" - ) - - testthat::expect_error( - cdisc_data( - adsl, - adtte, - code = "ADSL <- synthetic_cdisc_data(\"latest\")$adsl\nADTTE <- synthetic_cdisc_data(\"latest\")$adtte", # nolint - check = TRUE - ) - ) - - testthat::expect_silent( - data <- cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - cdisc_dataset("ADTTE", adtte_raw), - code = paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ), - check = TRUE - ) - ) - - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADSL"), - data$get_code(), - ) - testthat::expect_identical( - data$get_code("ADTTE"), - data$get_code() - ) - testthat::expect_error(cdisc_dataset("ADSL", adsl_raw)$check(), "code is empty") - testthat::expect_error(cdisc_dataset("ADTTE", adtte_raw)$check(), "code is empty") - testthat::expect_true(data$check()) - - # MUTATE - adsl <- cdisc_dataset(dataname = "ADSL", x = adsl_raw) - adtte <- cdisc_dataset(dataname = "ADTTE", x = adtte_raw) - - testthat::expect_silent( - data <- cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - cdisc_dataset("ADTTE", adtte_raw), - code = paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ), - check = TRUE - ) %>% - 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_error(adsl$check(), "code is empty") - testthat::expect_error(adtte$check(), "code is empty") - testthat::expect_true(data$check()) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_reference( - data$get_dataset("ADSL")$get_raw_data(), - adsl_raw - ) - testthat::expect_reference( - data$get_dataset("ADTTE")$get_raw_data(), - adtte_raw - ) - data$execute_mutate() - - new_env <- new.env() - eval(parse(text = data$get_code(), keep.source = FALSE), envir = new_env) - testthat::expect_identical( - get(x = "ADSL", envir = new_env), - data$get_dataset("ADSL")$get_raw_data() - ) - testthat::expect_identical( - get(x = "ADTTE", envir = new_env), - data$get_dataset("ADTTE")$get_raw_data() - ) -}) - -# 4. dataset + connector / code for dataset ------------------------------- -testthat::test_that("dataset + connector / global code", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - - testthat::expect_silent( - data <- cdisc_data(adsl, adtte, check = TRUE) - ) - - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_true(data$check()) - testthat::expect_silent(load_dataset(adtte)) - testthat::expect_true(data$check()) - - # MUTATE - adsl <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - adtte <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADSL"), vars = list(x = adsl)) - - testthat::expect_silent( - data <- cdisc_data( - adsl, - adtte, - check = TRUE - ) %>% - 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(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADTTE"), - paste( - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, USUBJID %in% ADSL$USUBJID)", - sep = "\n" - ) - ) - - testthat::expect_true(data$check()) - load_dataset(adtte) - testthat::expect_true(data$check()) -}) - -# 5.dataset + connector / global code -testthat::test_that("two datasets / datasets code", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- cdisc_dataset("ADSL", adsl_raw) - adrs <- cdisc_dataset("ADRS", adrs_raw) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADSL"), vars = list(x = adsl)) - adlb_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADLB")))) - } - ) - adlb <- cdisc_dataset_connector("ADLB", adlb_cf, keys = get_cdisc_keys("ADLB"), vars = list(x = adsl)) - - testthat::expect_identical( - adtte$get_code(), - paste( - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - data <- cdisc_data( - adsl, - adlb, - adtte, - adrs, - code = paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - sep = "\n" - ), - check = TRUE - ) - - testthat::expect_identical( - data$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "x <- ADSL", - "ADLB <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADLB\"))))", - "})()", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "x <- ADSL", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "x <- ADSL", - "ADLB <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADLB\"))))", - "})()", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "x <- ADSL", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(FALSE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADRS <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADRS\"))))", - "x <- ADSL", - "ADLB <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADLB\"))))", - "})()", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - load_dataset(adtte) - load_dataset(adlb) - testthat::expect_silent(data$check()) - - # MUTATE - adsl <- cdisc_dataset("ADSL", adsl_raw) - adtte <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - data <- cdisc_data( - adsl, - adtte, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - check = TRUE - ) %>% - 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(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, !(USUBJID %in% ADSL$USUBJID))", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADSL$x <- 1", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL <- dplyr::filter(ADSL, USUBJID == \"a\")", - "ADTTE <- dplyr::filter(ADTTE, !(USUBJID %in% ADSL$USUBJID))", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADSL"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "x <- ADSL", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(dataname = "ADTTE"), - paste( - "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - load_dataset(adtte) - testthat::expect_true(data$check()) # TRUE - data$execute_mutate() - testthat::expect_identical( - vapply( - list( - ADSL = data$get_dataset("ADSL")$get_raw_data(), - ADTTE = data$get_dataset("ADSL")$get_raw_data() - ), - nrow, - numeric(1) - ), - c(ADSL = 1, ADTTE = 1) - ) -}) - -# 5. only connectors ------ -testthat::test_that("only connectors", { - adsl_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) - } - ) - adsl <- cdisc_dataset_connector( - dataname = "ADSL", - pull_callable = adsl_cf, - keys = get_cdisc_keys("ADSL") - ) - adtte_cf <- callable_function( - function() { - as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - } - ) - adtte <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) - - testthat::expect_error( - cdisc_data(adsl, adtte, code = "test", check = TRUE), - "Connectors are reproducible by default and setting 'code' argument might break it" - ) - - testthat::expect_silent( - data <- cdisc_data(adsl, adtte, check = TRUE) %>% - mutate_dataset(dataname = "ADSL", code = "ADSL$test <- 1") %>% - mutate_dataset( - dataname = "ADTTE", - code = "ADTTE$test <- ADSL$test", - vars = list(ADSL = adsl) - ) %>% - mutate_dataset(dataname = "ADSL", code = "ADSL$x <- 1") - ) - - testthat::expect_identical( - data$get_code_class(TRUE)$get_code(), - paste( - "ADSL <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})()", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code("ADSL"), - paste( - "ADSL <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})()", - "x <- ADSL", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code_class(TRUE)$get_code("ADTTE"), - paste( - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - sep = "\n" - ) - ) - - testthat::expect_identical( - data$get_code("ADSL"), - paste( - "ADSL <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})()", - "x <- ADSL", - "ADSL$test <- 1", - "ADSL$x <- 1", - sep = "\n" - ) - ) - testthat::expect_identical( - data$get_code("ADTTE"), - paste( - "ADSL <- (function() {\n as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - "})()", - "x <- ADSL", - "ADTTE <- (function() {", - " as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))", - "})()", - "ADSL$test <- 1", - "ADTTE$test <- ADSL$test", - sep = "\n" - ) - ) - - load_dataset(adsl) - load_dataset(adtte) - testthat::expect_true(data$check()) -}) - -testthat::test_that("Basic example - without code and check", { - testthat::expect_silent(cdisc_data(cdisc_dataset("ADSL", adsl_raw), code = "", check = FALSE)) - testthat::expect_silent(cdisc_data(cdisc_dataset("ADSL", adsl_raw), - cdisc_dataset("ARG1", adsl_raw, keys = get_cdisc_keys("ADSL")), - cdisc_dataset("ARG2", adsl_raw, keys = get_cdisc_keys("ADSL")), - code = "", check = FALSE - )) -}) - -testthat::test_that("Basic example - check overall code", { - testthat::expect_silent( - cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - cdisc_dataset("ARG1", adsl_raw, keys = get_cdisc_keys("ADSL")), - cdisc_dataset("ARG2", adsl_raw, keys = get_cdisc_keys("ADSL")), - code = "ADSL <- ARG1 <- ARG2 <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", - check = TRUE - ) - ) - - testthat::expect_error( - cdisc_data( - cdisc_dataset( - "ADSL", - adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ), - cdisc_dataset("ARG1", adsl_raw, keys = get_cdisc_keys("ADSL")), - cdisc_dataset("ARG2", adsl_raw, keys = get_cdisc_keys("ADSL")), - code = "test", - check = TRUE - ), - "'code' argument should be specified only in the 'cdisc_data' or in 'cdisc_dataset' but not in both" - ) - - testthat::expect_error( - cdisc_data( - cdisc_dataset( - "ADSL", - adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ), - cdisc_dataset( - dataname = "ARG1", - x = dplyr::mutate(adsl_raw, x1 = 1), - keys = get_cdisc_keys("ADSL"), - code = "ARG1 <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ), - cdisc_dataset( - "ARG2", - adsl_raw, - keys = get_cdisc_keys("ADSL"), - code = "ARG2 <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ), - check = TRUE - ), - "Reproducibility check failed." - ) -}) - -testthat::test_that("Basic example - dataset depending on other dataset", { - testthat::expect_silent( - cdisc_data( - cdisc_dataset( - "ADSL", - adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ), - check = TRUE - ) - ) - - arg2 <- cdisc_dataset( - dataname = "ARG2", x = adsl_raw, keys = get_cdisc_keys("ADSL"), - code = "ARG2 <- ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" - ) - - arg1 <- cdisc_dataset( - dataname = "ARG1", - x = adsl_raw, - keys = get_cdisc_keys("ADSL"), - code = "ARG1 <- ARG2", - vars = list(ARG2 = arg2) - ) - - adsl <- cdisc_dataset(dataname = "ADSL", x = adsl_raw, code = "ADSL <- ARG2", vars = list(ARG2 = arg2)) - - testthat::expect_silent(cd <- cdisc_data(arg2, arg1, adsl, check = TRUE)) - - testthat::expect_true(arg1$check()) - testthat::expect_true(arg2$check()) - testthat::expect_true(adsl$check()) - testthat::expect_true(cd$check()) -}) - -testthat::test_that("Basic example - failing dataset code", { - testthat::expect_silent( - dataset <- cdisc_dataset("ADSL", head(iris), code = "ADSL <- data.frame(a = 1, b = 2)") - ) - testthat::expect_false(dataset$check()) -}) - -testthat::test_that("Basic example - missing code for dataset", { - testthat::expect_silent( - cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - code = c("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))"), - check = TRUE - ) - ) - - testthat::expect_silent( - cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - code = c("ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))"), - check = FALSE - ) - ) -}) - -testthat::test_that("Code argument of the constructor can have line breaks", { - testthat::expect_silent( - cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - code = "head(iris)\n 7", check = FALSE - ) - ) -}) - -testthat::test_that("Naming list elements", { - testthat::expect_identical( - names( - get_datasets( - cdisc_data(cdisc_dataset("ADSL", adsl_raw)) - ) - ), "ADSL" - ) - testthat::expect_identical( - names(get_datasets(cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - cdisc_dataset("ADTTE", adtte_raw), - cdisc_dataset("ADRS", adrs_raw) - ))), - c("ADSL", "ADTTE", "ADRS") - ) -}) - -testthat::test_that("List values", { - test_relational_data_equal <- function(data1, data2) { - testthat::expect_equal(data1$get_items(), data2$get_items()) - testthat::expect_equal(data1$get_join_keys(), data2$get_join_keys()) - mapply(testthat::expect_equal, data1$get_ui("test"), data2$get_ui("test")) - } - - result <- cdisc_data(cdisc_dataset("ADSL", adsl_raw, label = "test_label")) - - datasets <- list(cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - keys = c("STUDYID", "USUBJID"), - parent = character(0), - label = "test_label" - )) - - result_to_compare <- do.call(cdisc_data, datasets) - - test_relational_data_equal(result, result_to_compare) - - result <- cdisc_data(cdisc_dataset("ADSL", adsl_raw), cdisc_dataset("ADTTE", adtte_raw)) - - datasets <- list( - cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - keys = c("STUDYID", "USUBJID"), - parent = character(0), - label = character(0) - ), - cdisc_dataset( - dataname = "ADTTE", - x = adtte_raw, - keys = c("STUDYID", "USUBJID", "PARAMCD"), - parent = "ADSL", - label = character(0) - ) - ) - - result_to_compare <- do.call("cdisc_data", datasets) - - test_relational_data_equal(result, result_to_compare) -}) - -testthat::test_that("get_cdisc_keys returns column names present in the cached datasets", { - scda_data <- scda::synthetic_cdisc_data("latest") - - testthat::expect_true(all(get_cdisc_keys("ADSL") %in% names(scda_data$adsl))) - - testthat::expect_true(all(get_cdisc_keys("ADAE") %in% names(scda_data$adae))) - - testthat::expect_true(all(get_cdisc_keys("ADTTE") %in% names(scda_data$adtte))) - - testthat::expect_true(all(get_cdisc_keys("ADCM") %in% names(scda_data$adcm))) - - testthat::expect_true(all(get_cdisc_keys("ADLB") %in% names(scda_data$adlb))) - - testthat::expect_true(all(get_cdisc_keys("ADRS") %in% names(scda_data$adrs))) - - testthat::expect_true(all(get_cdisc_keys("ADVS") %in% names(scda_data$advs))) -}) - -testthat::test_that("Empty code", { - # missing code - result <- cdisc_data(cdisc_dataset("ADSL", adsl_raw), check = FALSE) - testthat::expect_identical(result$get_code(), "") - - # empty code - result <- cdisc_data(cdisc_dataset("ADSL", adsl_raw), code = "", check = FALSE) - testthat::expect_identical(result$get_code(), "") - - # NULL code - testthat::expect_silent(cdisc_data(cdisc_dataset("ADSL", adsl_raw), code = NULL, check = FALSE)) -}) - -testthat::test_that("Error - objects differs", { - testthat::expect_error( - cdisc_data(cdisc_dataset("ADSL", adsl_raw, code = "ADSL <- 2"), check = TRUE), - "Code from ADSL need to return a data.frame" - ) - - testthat::expect_error( - cdisc_data(cdisc_dataset("ADSL", adsl_raw, code = "ADSL <- data.frame()"), check = TRUE), - "Reproducibility check failed." - ) - - testthat::expect_error( - cdisc_data(cdisc_dataset("ADSL", adsl_raw, code = "ADSL <- mtcars;"), check = TRUE), - "Reproducibility check failed." - ) -}) - -testthat::test_that("Error - ADSL is missing in cdisc_data", { - testthat::expect_error( - object = { - x <- cdisc_data( - cdisc_dataset("ADTTE", adtte_raw), - code = "ADTTE <- synthetic_cdisc_data(\"latest\")$adtte", check = FALSE - ) - x$check_metadata() - }, - "ADSL dataset is missing." - ) -}) - -testthat::test_that("Error - duplicated names", { - testthat::expect_error( - cdisc_data( - cdisc_dataset("ADSL", adsl_raw), - cdisc_dataset("ADSL", adsl_raw), - code = "", - check = FALSE - ), - "TealDatasets names should be unique" - ) -}) - -testthat::test_that("Error - dataset is not of correct class", { - testthat::expect_error( - cdisc_data(ARG1 = 1, code = "", check = FALSE), - "All elements should be of TealDataset(Connector) or TealDataConnector class", - fixed = TRUE - ) -}) - -testthat::test_that("Check the keys", { - testthat::expect_error( - teal_data(dataset(dataname = "ADSL", x = adsl_raw, keys = "non_existing_column")), - "The join key specification requires dataset ADSL to contain the following columns: non_existing_column" - ) - - data2 <- cdisc_data(dataset("ADSL", adsl_raw), dataset("ADTTE", adtte_raw)) - testthat::expect_identical( - data2$get_dataset("ADSL")$get_keys(), - character(0) - ) - testthat::expect_identical( - data2$get_dataset("ADTTE")$get_keys(), - character(0) - ) - - # we can have empty keys - then we don't check them - testthat::expect_silent(data2$check_metadata()) - - adsl_extended <- rbind(adsl_raw, get_cdisc_keys("ADSL")) - ds <- cdisc_dataset("ADSL", adsl_extended, keys = get_cdisc_keys("ADSL")[1]) - testthat::expect_error( - ds$check_keys(), - "Duplicate primary key values found in the dataset 'ADSL'" - ) - - testthat::expect_error( - cdisc_data(ds), - "Duplicate primary key values found in the dataset 'ADSL'" - ) -}) - -# 7. invalid arguments ----- -testthat::test_that("Cannot create TealData if arguments include TealData object", { - c_data <- cdisc_data( - cdisc_dataset("ADSL", adsl_raw) - ) - - testthat::expect_error(cdisc_data(c_data)) - testthat::expect_error(cdisc_data(cdisc_dataset("ADSL", adsl_raw), c_data)) -}) diff --git a/tests/testthat/test-JoinKeys.R b/tests/testthat/test-JoinKeys.R index 59d36bb22..f3e9c80c4 100644 --- a/tests/testthat/test-JoinKeys.R +++ b/tests/testthat/test-JoinKeys.R @@ -1,5 +1,4 @@ test_that("join_key throws error with invalid keys arguments", { - # invalid types expect_error(join_key("d1", "d2", keys = NULL)) expect_error(join_key("d1", "d2", keys = 1:10)) @@ -35,7 +34,6 @@ test_that("key empty name is changed to the key value", { }) test_that("join_key throws error with invalid dataset arguments", { - # missing expect_error(join_key("d1", as.character(NA), keys = c("A" = "B", "C" = "D"))) # invalid type @@ -46,7 +44,6 @@ test_that("join_key throws error with invalid dataset arguments", { test_that("join_key does not throw error with valid arguments", { - # keys of length 0 expect_silent(join_key("d1", "d2", keys = character(0))) # keys of length 1 @@ -59,7 +56,6 @@ test_that("join_key does not throw error with valid arguments", { test_that("cannot set join_keys with incompatible keys", { - # different keys expect_error( join_keys( @@ -98,7 +94,6 @@ test_that("cannot set join_keys with incompatible keys", { }) test_that("can create join_keys with compatible information", { - # different datasets expect_silent( join_keys( @@ -149,7 +144,6 @@ test_that("can create join_keys with compatible information", { test_that("cannot create JoinKeys with invalid arguments", { - # not using join_key expect_error(join_keys("d1", "d2", "A")) # key sets with the same pair of datasets but different values @@ -547,3 +541,107 @@ testthat::test_that("JoinKeys$print for a non-empty set", { "A JoinKeys object containing foreign keys between 2 datasets:" ) }) + +testthat::test_that("JoinKeys$set_parents sets the parents of datasets when they are empty", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "fk")))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) + testthat::expect_identical( + ss <- jk$get_parents(), + list(df1 = character(0), df2 = "df1") + ) +}) + +testthat::test_that("JoinKeys$set_parents throws error when overwriting the parent value with a different value", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) + testthat::expect_error(jk$set_parents(list(df1 = character(0), df2 = "df5"))) +}) + +testthat::test_that("JoinKeys$set_parents works when overwriting the parent value with the same value", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) +}) + +testthat::test_that("JoinKeys$get_parent returns the parent name of the dataset", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) + testthat::expect_identical(jk$get_parent("df1"), character(0)) + testthat::expect_identical(jk$get_parent("df2"), "df1") +}) + +testthat::test_that("JoinKeys$get_parent returns NULL when dataset is not found or not passed", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) + testthat::expect_null(jk$get_parent()) + testthat::expect_null(jk$get_parent("df3")) +}) + +testthat::test_that("JoinKeys$get_parents returns a list of all parents", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_silent(jk$set_parents(list(df1 = character(0), df2 = "df1"))) + testthat::expect_identical(jk$get_parents(), list(df1 = character(0), df2 = "df1")) +}) + +testthat::test_that("JoinKeys$get_parents returns an empty list when no parents are present", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_identical(jk$get_parents(), list()) +}) + +testthat::test_that("JoinKeys$get_parents throws error when dataname input is provided", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + testthat::expect_error(jk$get_parents("df1"), "unused argument \\(\"df1\"\\)") +}) + +testthat::test_that("JoinKeys$update_keys_given_parents does not update the join_keys when no presents are present", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df2", c("id" = "id")))) + jk$update_keys_given_parents() + testthat::expect_equal(jk, join_keys(join_key("df1", "df2", c("id" = "id")))) +}) + +testthat::test_that("JoinKeys$update_keys_given_parents updates the join_keys when presents are present", { + jk <- JoinKeys$new() + jk$set(list( + join_key("df1", "df1", c("id", "id2")), + join_key("df1", "df2", c("id" = "id")), + join_key("df1", "df3", c("id" = "id")) + )) + jk$set_parents(list(df1 = character(0), df2 = "df1", df3 = "df1")) + jk$update_keys_given_parents() + expected_jk <- join_keys( + join_key("df1", "df1", c("id", "id2")), + join_key("df1", "df2", c("id" = "id")), + join_key("df1", "df3", c("id" = "id")), + join_key("df2", "df2", c("id", "id2")), + join_key("df2", "df3", c("id", "id2")), + join_key("df3", "df3", c("id", "id2")) + ) + expected_jk$set_parents(list(df1 = character(0), df2 = "df1", df3 = "df1")) + testthat::expect_equal(jk, expected_jk) +}) + +testthat::test_that("JoinKeys$check_parent_child does nothing if no parents are present", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df1", c("id" = "id")))) + testthat::expect_identical(jk$get_parents(), list()) + testthat::expect_silent(jk$.__enclos_env__$private$check_parent_child()) +}) + +testthat::test_that("JoinKeys$check_parent_child throws error if no join_keys exist for chuld-parent", { + jk <- JoinKeys$new() + jk$set(list(join_key("df1", "df1", c("id" = "id")))) + jk$set_parents(list(df1 = character(0), df2 = "df1", df3 = "df1")) + testthat::expect_error( + jk$.__enclos_env__$private$check_parent_child(), + "No join keys from df2 to its parent \\(df1\\) and vice versa" + ) +}) diff --git a/tests/testthat/test-TealData.R b/tests/testthat/test-TealData.R index e4078c89f..d5ee39e7a 100644 --- a/tests/testthat/test-TealData.R +++ b/tests/testthat/test-TealData.R @@ -1,238 +1,363 @@ -test_that("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 <- teal_data( - dataset("df_1", df_1), - dataset("df_2", df_2), - join_keys = join_keys - ) - } - - expect_silent( - constructor_wrapper( - join_keys = join_keys() - )$check_metadata() +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" ) - expect_silent( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "u"))) - )$check_metadata() + testthat::expect_error( + TealData$new(mtcars), + "All elements should be of TealDataset\\(Connector\\) or TealDataConnector class" ) +}) - expect_silent( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "u", "y" = "v"))) - )$check_metadata() +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 ) - expect_silent( - constructor_wrapper( - join_keys = join_keys(join_key("df_2", "df_2", c("u" = "u"))) - )$check_metadata() + data2 <- TealData$new(df1, df2) + testthat::expect_equal( + data2$get_join_keys(), + join_keys() ) }) -test_that("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 <- teal_data( - dataset("df_1", df_1), - dataset("df_2", df_2), - 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() - expect_error( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "w"))) - )$check_metadata() + 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)) +}) - expect_error( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "y", "v" = "v"))) - )$check_metadata() +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 ) +}) - expect_error( - constructor_wrapper( - join_keys = join_keys(join_key("df_1", "df_2", c("x" = "x"))) - )$check_metadata() +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" + ) ) }) -test_that("get_check method is default FALSE", { - data <- teal_data(dataset("df_1", data.frame(x = 1:10, y = 1:10))) - expect_false(data$get_check()) +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()) }) -test_that("get_check_result method returns true if object created with check = TRUE", { - data <- teal_data( - dataset("df_1", data.frame(x = 1:10, y = 1:10)), - code = "df_1 <- data.frame(x = 1:10, y = 1:10)", check = TRUE - ) - expect_true(data$get_check()) +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) }) -test_that("deep clone", { - ## TealDatasetConnector - expect_silent({ - x_c <- CallableFunction$new(data.frame) - x_c$set_args(list(c1 = seq_len(10))) - x <- dataset_connector("x", x_c) - }) +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) +}) - expect_silent({ - x_copy <- x$clone(deep = TRUE) - }) +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) + } - expect_silent({ - load_dataset(x) - }) + 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) +}) - expect_true(is_pulled(x)) - expect_false(is_pulled(x_copy)) +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)) +}) - # check one of the private fields of R6 class - expect_false(rlang::is_reference(x$get_pull_callable(), x_copy$get_pull_callable())) +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") +}) - ## TealData - expect_silent({ - x1 <- dataset("x1", data.frame(col1 = seq_len(10))) - x2 <- dataset("x2", data.frame(col2 = seq_len(10))) - x <- TealData$new(x1, x2) - }) +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)) +}) - expect_silent({ - x_copy <- x$clone(deep = TRUE) - }) +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()) +}) - # check one of the private fields of list of R6 class object - expect_false(rlang::is_reference(x$get_items()[[1]], x_copy$get_items()[[1]])) - # check one of the private fields of R6 class - expect_false(rlang::is_reference(x$get_join_keys(), x_copy$get_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)) - ## TealDataConnector - expect_silent({ - x1_c <- CallableFunction$new(data.frame) - x1_c$set_args(list(n = seq_len(10))) - x1 <- dataset_connector("x1", x1_c) + df1 <- dataset("df1", df1, keys = "id") + df2 <- dataset("df2", df2, keys = "df2_id") - x2_c <- CallableFunction$new(data.frame) - x2_c$set_args(list(n = seq_len(20))) - x2 <- dataset_connector("x2", x2_c) + jk <- join_keys(join_key("df1", "df2", "id")) + data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - x <- teal.data:::TealData$new(x1, x2) - }) + testthat::expect_equal( + data$get_join_keys(), + join_keys( + join_key("df1", "df2", "id"), + join_key("df2", "df1", "id") + ) + ) +}) - expect_silent({ - x_copy <- x$clone(deep = TRUE) - }) +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)) - expect_silent({ - lapply(x$get_items(), load_dataset) - }) + df1 <- dataset("df1", df1, keys = "id") + df2 <- dataset("df2", df2, keys = "df2_id") - expect_true(is_pulled(x)) - expect_false(is_pulled(x_copy)) + jk <- join_keys(join_key("df1", "df2", "id")) + data <- TealData$new(df1, df2, join_keys = jk, check = FALSE) - # check one of the private fields of list of R6 class object - expect_false(rlang::is_reference(x$get_items()[[1]], x_copy$get_items()[[1]])) - # check one of the private fields of R6 class - expect_false(rlang::is_reference(x$get_join_keys(), x_copy$get_join_keys())) + testthat::expect_equal( + data$get_join_keys("df1"), + list(df2 = setNames("id", "id")) + ) }) -testthat::test_that("execute_mutate returns current datasets if no mutate_code", { - pull_fun <- callable_function(data.frame) - pull_fun$set_args(args = list(head_letters = head(letters))) - t_dc <- dataset_connector("test_dc", pull_fun) - t_ds <- dataset("head_rock", head(rock), code = "head_rock <- head(rock)") %>% - mutate_dataset("head_rock$head_letters <- test_dc$head_letters", vars = list(test_dc = t_dc)) - data <- teal_data(t_dc, t_ds) - testthat::expect_identical( - data$execute_mutate(), - list(head_rock = t_ds) +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") ) }) -# Multiple connectors ---- -testthat::test_that("Multiple connectors wrapped in cdisc_data", { - 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) - } +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()) +}) - adsl <- scda_cdisc_dataset_connector("ADSL", "adsl") - adae <- scda_cdisc_dataset_connector("ADAE", "adae") - advs <- scda_cdisc_dataset_connector("ADVS", "advs") - adsl_2 <- code_cdisc_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 <- cdisc_data(adsl_adae, advs_adsl_2) +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)) - 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"))) + df1 <- dataset("df1", df1, keys = "id") + df2 <- dataset("df2", df2, keys = "df2_id") - testthat::expect_equal(unname(get_dataname(data)), c("ADSL", "ADAE", "ADVS", "ADSL_2")) + 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( - items$ADSL$get_code(), - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" + 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( - items$ADAE$get_code(), - "ADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" + data$get_join_keys(), + join_keys( + join_key("df1", "df2", "id") + ) ) - testthat::expect_equal( - items$ADVS$get_code(), - "ADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" +}) + +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() ) - testthat::expect_equal( - items$ADSL_2$get_code(), - "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\nADSL_2 <- ADSL" + + expect_error( + constructor_wrapper( + join_keys = join_keys(join_key("df_1", "df_2", c("x" = "y", "v" = "v"))) + )$check_metadata() ) - testthat::expect_equal( - data$get_code("ADSL"), - "library(package = \"teal\")\nADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" # nolint + expect_error( + constructor_wrapper( + join_keys = join_keys(join_key("df_1", "df_2", c("x" = "x"))) + )$check_metadata() ) - testthat::expect_equal( - data$get_code("ADAE"), - "library(package = \"teal\")\nADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" # nolint +}) + +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() ) - testthat::expect_equal( - data$get_code("ADVS"), - "library(package = \"teal\")\nADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" # nolint + + expect_silent( + constructor_wrapper( + join_keys = join_keys(join_key("df_1", "df_2", c("x" = "u", "y" = "v"))) + )$check_metadata() ) - 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" - ) + + expect_silent( + constructor_wrapper( + join_keys = join_keys(join_key("df_2", "df_2", c("u" = "u"))) + )$check_metadata() ) - 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" - ) +}) + +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." ) }) @@ -246,45 +371,31 @@ testthat::test_that("TealData with single dataset and connector", { TealDataConnector$new(connection = con, connectors = connectors) } - adsl <- scda_cdisc_dataset_connector("ADSL", "adsl") + adsl <- scda_dataset_connector("ADSL", "adsl") adsl_data <- example_data_connector(adsl) - adtte <- cdisc_dataset( + 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\")" ) - adae <- scda_cdisc_dataset_connector("ADAE", "adae") - adae$set_ui_input(function(ns) { - list( - textInput(inputId = ns("name"), label = "scda name", value = "latest") - ) - }) - - data <- cdisc_data(adsl_data, adtte, adae) + data <- TealData$new(adsl_data, adtte) items <- data$get_items() - testthat::expect_length(items, 3) + 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")) - testthat::expect_true(inherits(items$ADAE, "TealDatasetConnector")) connectors <- data$get_connectors() - testthat::expect_length(connectors, 2) - testthat::expect_true( - inherits(connectors[[1]], "TealDataConnector") && - inherits(connectors[[2]], "TealDatasetConnector") - ) + 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_equal( - items$ADAE$get_pull_callable()$get_call(), - "scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" - ) + testthat::expect_identical(adtte$get_raw_data(), items$ADTTE$get_raw_data()) # simulate pull with a click of the submit button @@ -306,20 +417,13 @@ testthat::test_that("TealData with single dataset and connector", { "ADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" ) ) - testthat::expect_equal( - data$get_code("ADAE"), - paste0( - "library(package = \"teal.data\")\n", - "ADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", 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\")\n", - "ADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" + "ADTTE <- scda::synthetic_cdisc_dataset(dataset_name = \"adtte\", archive_name = \"latest\")" ) ) }) @@ -357,16 +461,16 @@ testthat::test_that("TealData with mutliple datasets and connectors", { return(x) } - adsl <- scda_cdisc_dataset_connector("ADSL", "adsl") + adsl <- scda_dataset_connector("ADSL", "adsl") adsl_data <- example_data_connector(adsl) - adtte <- cdisc_dataset( + 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_cdisc_dataset_connector("ADSL_2", "ADSL", keys = get_cdisc_keys("ADSL"), ADSL = adsl) + 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( @@ -374,22 +478,22 @@ testthat::test_that("TealData with mutliple datasets and connectors", { ) }) - advs <- scda_cdisc_dataset_connector("ADVS", "advs") + 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_cdisc_dataset_connector("ADLB", "adlb") + 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_cdisc_dataset_connector(dataname = "ADRS", file = temp_file) + adrs <- rds_dataset_connector(dataname = "ADRS", file = temp_file) - adsamp <- script_cdisc_dataset_connector( + adsamp <- script_dataset_connector( dataname = "ADSAMP", keys = get_cdisc_keys("ADVS"), file = "delayed_data_script/asdamp_with_adsl.R", @@ -397,7 +501,7 @@ testthat::test_that("TealData with mutliple datasets and connectors", { ADVS = advs ) - data <- cdisc_data(adsl_data, adtte, adsl_2, advs_adlb_data, adrs, adsamp) + data <- TealData$new(adsl_data, adtte, adsl_2, advs_adlb_data, adrs, adsamp) testthat::expect_true(inherits(data, "TealData")) items <- data$get_items() @@ -458,266 +562,78 @@ testthat::test_that("TealData with mutliple datasets and connectors", { ) }) -testthat::test_that("TealData$print prints out expected output on basic input", { - adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL"), object = list(1:3, letters[1:3])))) - adsl <- cdisc_dataset( - dataname = "ADSL", - x = adsl_raw, - code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"), object = list(1:3, letters[1:3]))))" - ) - adtte_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) - adtte <- cdisc_dataset( - dataname = "ADTTE", - x = adtte_raw, - code = "ADTTE <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADTTE\"))))" - ) - data <- cdisc_data(adsl, adtte, check = TRUE) +# 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) + } - out <- capture.output(print(data)) - testthat::expect_equal( - out, - c( - "A CDISCTealData object containing 2 TealDataset/TealDatasetConnector object(s) as element(s):", - "--> Element 1:", - "A CDISCTealDataset object containing the following data.frame (3 rows and 2 columns):", - " STUDYID USUBJID", - "1 1 a", - "2 2 b", - "3 3 c", - "--> Element 2:", - "A CDISCTealDataset object containing the following data.frame (1 rows and 3 columns):", - " STUDYID USUBJID PARAMCD", - "1 STUDYID USUBJID PARAMCD" - ) + 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) -testthat::test_that("clone(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$clone(deep = TRUE) - testthat::expect_false(identical(data, data_cloned)) - testthat::expect_false(identical(data_cloned$get_items()$test_ds0, test_ds0)) -}) + 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::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::expect_equal(names(items), c("ADSL", "ADAE", "ADVS", "ADSL_2")) -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::expect_equal( + items$ADSL$get_code(), + "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" ) -}) - -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) + testthat::expect_equal( + items$ADAE$get_code(), + "ADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" ) - 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("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) + testthat::expect_equal( + items$ADVS$get_code(), + "ADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" ) - 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 + testthat::expect_equal( + items$ADSL_2$get_code(), + "ADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")\nADSL_2 <- ADSL" ) -}) - -testthat::test_that("TealData$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("TealData$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("TealData$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("TealData$check returns TRUE if the code is reproducible", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_true(data$check()) -}) - -testthat::test_that("TealData$get_dataset throws an error if no dataset is found with the passed name", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_error(data$get_dataset("iris"), "dataset iris not found") -}) - -testthat::test_that("TealData$get_dataset returns the dataset with the passed name", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - data <- TealData$new(mtcars_ds, check = TRUE) - testthat::expect_identical(data$get_dataset("cars"), mtcars_ds) -}) - -testthat::test_that("TealData$get_dataset returns a list of all datasets if passed NULL", { - mtcars_ds <- TealDataset$new("cars", head(mtcars), code = "cars <- head(mtcars)") - iris_ds <- TealDataset$new("iris", head(iris), code = "iris <- head(iris)") - data <- TealData$new(cars = mtcars_ds, iris = iris_ds, check = TRUE) - testthat::expect_equal(data$get_dataset(), list(cars = mtcars_ds, iris = iris_ds)) -}) - -testthat::test_that("TealData$get_items returns a dataset with the passed 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 throws an error if there is no dataset found with the passed name", { - 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$new throws if dataname is set to invalid R object name", { - testthat::expect_error(TealDataset$new("", head(mtcars)), "name '' must only contain alphanumeric characters") -}) - -testthat::test_that("TealData$new 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("TealData$new sets join_keys datasets based on the primary keys", { - 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) testthat::expect_equal( - data$get_join_keys(), - join_keys(join_key("df1", "df1", "id"), join_key("df2", "df2", "df2_id")) + data$get_code("ADSL"), + "library(package = \"teal\")\nADSL <- scda::synthetic_cdisc_dataset(dataset_name = \"adsl\", archive_name = \"latest\")" # nolint ) -}) - -testthat::test_that("TealData$new sets passed join_keys to datasets correctly", { - 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 <- teal_data(df1, df2, join_keys = jk, check = FALSE) - testthat::expect_equal( - data$get_join_keys(), - join_keys( - join_key("df1", "df2", "id"), - join_key("df1", "df1", "id"), - join_key("df2", "df2", "df2_id") - ) + data$get_code("ADAE"), + "library(package = \"teal\")\nADAE <- scda::synthetic_cdisc_dataset(dataset_name = \"adae\", archive_name = \"latest\")" # nolint ) -}) - -testthat::test_that("TealData$new sets passed JoinKeys to datasets correctly when key names differ", { - 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") - jk <- join_keys(join_key("df1", "df2", c(id = "fk"))) - data <- teal_data(df1, df2, join_keys = jk, check = FALSE) - testthat::expect_equal( - data$get_join_keys(), - join_keys( - join_key("df1", "df2", c(id = "fk")), - join_key("df1", "df1", "id"), - join_key("df2", "df1", c(fk = "id")), - join_key("df2", "df2", "df2_id") - ) + data$get_code("ADVS"), + "library(package = \"teal\")\nADVS <- scda::synthetic_cdisc_dataset(dataset_name = \"advs\", archive_name = \"latest\")" # nolint ) -}) - -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 <- teal_data(df1, df2, check = FALSE) - data$mutate_join_keys("df1", "df2", "id") - testthat::expect_equal( - data$get_join_keys(), - join_keys( - join_key("df1", "df1", "id"), - join_key("df1", "df2", "id"), - join_key("df2", "df2", "df2_id") + 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::test_that("TealData$new sets passes JoinKeys to datasets correctly when key names differ (multiple keys)", { - df1 <- data.frame(id = c("A", "B"), id2 = c("A", "B"), a = c(1L, 2L)) - df2 <- data.frame(df2_id = c("A", "B"), fk = c("A", "B"), fk2 = c("A", "B"), b = c(1L, 2L)) - df1 <- dataset("df1", df1, keys = "id") - df2 <- dataset("df2", df2, keys = "df2_id") - data <- teal_data(df1, df2, check = FALSE) - data$mutate_join_keys("df1", "df2", c(id = "fk", id2 = "fk2")) - testthat::expect_equal( - data$get_join_keys(), - join_keys( - join_key("df1", "df1", "id"), - join_key("df1", "df2", c(id = "fk", id2 = "fk2")), - join_key("df2", "df2", "df2_id"), - join_key("df2", "df1", c(fk = "id", fk2 = "id2")) + 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 index 83fe3c02a..0b1ff431f 100644 --- a/tests/testthat/test-TealDataAbstract.R +++ b/tests/testthat/test-TealDataAbstract.R @@ -1,3 +1,583 @@ +# 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-TealDataset.R b/tests/testthat/test-TealDataset.R index 5d9a7c5ff..1705e47e2 100644 --- a/tests/testthat/test-TealDataset.R +++ b/tests/testthat/test-TealDataset.R @@ -508,69 +508,6 @@ testthat::test_that("TealDataset$is_mutate_delayed stays FALSE if the TealDatase testthat::expect_false(dataset1$is_mutate_delayed()) }) -testthat::test_that("TealDataset$get_join_keys returns an empty JoinKeys object", { - dataset1 <- TealDataset$new("iris", head(iris)) - testthat::expect_true(inherits(dataset1$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(dataset1$get_join_keys()$get()), 0) -}) - -testthat::test_that("TealDataset$set_join_keys works independently", { - dataset1 <- TealDataset$new("iris", head(iris)) - testthat::expect_silent( - dataset1$set_join_keys(join_key("iris", "other_dataset", c("Species" = "some_col"))) - ) - testthat::expect_error( - dataset1$set_join_keys(join_key("iris", "other_dataset", c("Sepal.Length" = "some_col2"))) - ) - testthat::expect_true(inherits(dataset1$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(dataset1$get_join_keys()$get()), 2) -}) - -testthat::test_that("TealDataset$mutate_join_keys works independently", { - dataset1 <- TealDataset$new("iris", head(iris)) - testthat::expect_silent( - dataset1$mutate_join_keys("other_dataset", c("Sepal.Length" = "some_col2")) - ) - testthat::expect_true(inherits(dataset1$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(dataset1$get_join_keys()$get()), 2) - - dataset2 <- TealDataset$new("iris", head(iris)) - testthat::expect_silent( - dataset2$mutate_join_keys("other_dataset", c("Sepal.Length")) - ) - testthat::expect_true(inherits(dataset2$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(dataset2$get_join_keys()$get()), 2) -}) - -testthat::test_that("TealDataset$set_join_keys works with TealDataset$mutate_join_keys", { - dataset1 <- TealDataset$new("iris", head(iris)) - testthat::expect_silent( - dataset1$set_join_keys(join_key("iris", "other_dataset", c("Species" = "some_col"))) - ) - testthat::expect_identical( - dataset1$get_join_keys()$get()$iris$other_dataset, c("Species" = "some_col") - ) - testthat::expect_silent( - dataset1$mutate_join_keys("other_dataset", c("Sepal.Length" = "some_col2")) - ) - dataset1$mutate(code = "iris$unique_id <- 1:2") - testthat::expect_silent( - dataset1$mutate_join_keys("iris", "unique_id") - ) - testthat::expect_silent( - join_keys_list <- dataset1$get_join_keys()$get() - ) - testthat::expect_identical( - dataset1$get_join_keys()$get()$iris$other_dataset, c("Sepal.Length" = "some_col2") - ) - testthat::expect_identical( - dataset1$get_join_keys()$get()$iris$iris, c("unique_id" = "unique_id") - ) - testthat::expect_identical( - dataset1$get_join_keys()$get()$other_dataset$iris, c("some_col2" = "Sepal.Length") - ) -}) - testthat::test_that("Dupliated mutation code is shown via get_code()", { dataset <- TealDataset$new("iris", head(iris)) dataset$mutate("7") @@ -752,22 +689,6 @@ test_that("mutate_dataset with vars argument", { ) }) -testthat::test_that("dataset$merge_join_keys does not throw on basic input", { - dataset1 <- TealDataset$new("iris", head(iris)) - dataset1$set_join_keys(join_key("iris", "other_dataset", c("Species" = "some_col"))) - - dataset2 <- TealDataset$new("iris", head(iris)) - dataset2$set_join_keys(join_key("iris", "other_dataset_2", c("Sepal.Length" = "some_col2"))) - - before_merge <- dataset1$get_join_keys()$get() - after_merge <- dataset1$merge_join_keys(dataset2$get_join_keys())$get_join_keys()$get() - - - testthat::expect_true(all(names(before_merge) %in% names(after_merge))) - testthat::expect_true(length(before_merge) < length(after_merge)) - testthat::expect_equal(names(after_merge), c("iris", "other_dataset", "other_dataset_2")) -}) - 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( diff --git a/tests/testthat/test-TealDatasetConnector.R b/tests/testthat/test-TealDatasetConnector.R index a8c007bcb..cbab7e15e 100644 --- a/tests/testthat/test-TealDatasetConnector.R +++ b/tests/testthat/test-TealDatasetConnector.R @@ -988,112 +988,6 @@ testthat::test_that("Initializing TealDatasetConnector with code argument works" ) }) -testthat::test_that("TealDatasetConnector$get_join_keys returns an empty JoinKeys object", { - 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)" - ) - testthat::expect_true(inherits(t_dc$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(t_dc$get_join_keys()$get()), 0) -}) - -testthat::test_that("TealDatasetConnector$set_join_keys works independently", { - 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)" - ) - testthat::expect_silent( - t_dc$set_join_keys(join_key("test_dc", "other_dataset", c("Species" = "some_col"))) - ) - testthat::expect_error( - t_dc$set_join_keys(join_key("test_dc", "other_dataset", c("Sepal.Length" = "some_col2"))) - ) - testthat::expect_true(inherits(t_dc$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(t_dc$get_join_keys()$get()), 2) -}) - -testthat::test_that("TealDatasetConnector$mutate_join_keys works independently", { - 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)" - ) - testthat::expect_silent( - t_dc$mutate_join_keys("other_dataset", c("Sepal.Length" = "some_col2")) - ) - testthat::expect_true(inherits(t_dc$get_join_keys(), "JoinKeys")) - testthat::expect_equal(length(t_dc$get_join_keys()$get()), 2) -}) - -testthat::test_that("TealDatasetConnector$set_join_keys works with TealDatasetConnector$mutate_join_keys", { - 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)" - ) - testthat::expect_silent( - t_dc$set_join_keys(join_key("iris", "other_dataset", c("Species" = "some_col"))) - ) - testthat::expect_identical( - t_dc$get_join_keys()$get()$iris$other_dataset, c("Species" = "some_col") - ) - testthat::expect_silent( - t_dc$mutate_join_keys("other_dataset", c("Sepal.Length" = "some_col2")) - ) - testthat::expect_silent( - t_dc$mutate_join_keys("iris", "unique_id") - ) - testthat::expect_silent( - join_keys_list <- t_dc$get_join_keys()$get() - ) - - testthat::expect_identical( - t_dc$get_join_keys()$get()$iris$other_dataset, c("Species" = "some_col") - ) - testthat::expect_identical( - t_dc$get_join_keys()$get()$test_dc$other_dataset, c("Sepal.Length" = "some_col2") - ) - testthat::expect_identical( - t_dc$get_join_keys()$get()$test_dc$iris, c("unique_id" = "unique_id") - ) - testthat::expect_identical( - t_dc$get_join_keys()$get()$other_dataset$test_dc, c("some_col2" = "Sepal.Length") - ) - testthat::expect_identical( - t_dc$get_join_keys()$get()$other_dataset$iris, c("some_col" = "Species") - ) -}) - -testthat::test_that("TealDatasetConnector$get_dataset calls dataset$merge_join_keys before returning", { - 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)" - ) - t_dc$pull() - - testthat::expect_equal(t_dc$get_dataset()$get_join_keys()$get(), list()) - # initial call - t_dc$mutate_join_keys("other_dataset", c("Sepal.Length" = "some_col2")) - testthat::expect_equal(t_dc$get_dataset()$get_join_keys(), t_dc$get_join_keys()) - - # subsequent calls - t_dc$mutate_join_keys("other_dataset", c("Sepal.Length" = "some_other_col")) - testthat::expect_equal(t_dc$get_dataset()$get_join_keys(), t_dc$get_join_keys()) -}) - 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) diff --git a/tests/testthat/test-cdisc_data.R b/tests/testthat/test-cdisc_data.R new file mode 100644 index 000000000..c7f8c8539 --- /dev/null +++ b/tests/testthat/test-cdisc_data.R @@ -0,0 +1,279 @@ +cdisc_data_mixed_call <- function(check = TRUE, join_keys1 = join_keys()) { + 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")))) + adae_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE")))) + + adsl <- cdisc_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 <- cdisc_dataset_connector("ADTTE", adtte_cf, keys = get_cdisc_keys("ADTTE"), vars = list(x = adsl)) + adae_cf <- callable_function( + function() { + as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADAE")))) + } + ) + adae_cdc <- cdisc_dataset_connector("ADAE", adae_cf, keys = get_cdisc_keys("ADAE")) + adae_rdc <- cdisc_data_connector( + connection = data_connection(open_fun = callable_function(function() "open function")), + connectors = list(adae_cdc) + ) + + load_dataset(adsl) + load_dataset(adtte) + load_dataset(adae_cdc) + + cdisc_data(adsl, adtte, adae_rdc, check = check, join_keys = join_keys1) +} + +testthat::test_that("cdisc_data accepts TealDataset, TealDatasetConnector, TealDataConnector objects", { + testthat::expect_silent(data <- cdisc_data_mixed_call()) + testthat::expect_identical(data$get_datanames(), c("ADSL", "ADTTE", "ADAE")) +}) + +testthat::test_that("cdisc_data throws error if it receives undesired objects", { + adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) + testthat::expect_error( + teal_data(adsl_raw, check = TRUE), + "May only contain the following types: \\{TealDataset,TealDatasetConnector,TealDataConnector\\}" + ) +}) + +testthat::test_that("cdisc_data sets the join_keys internally", { + data <- cdisc_data_mixed_call() + + jks <- join_keys( + join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")), + join_key("ADTTE", "ADTTE", c("STUDYID", "USUBJID", "PARAMCD")), + join_key("ADAE", "ADAE", c("STUDYID", "USUBJID", "ASTDTM", "AETERM", "AESEQ")), + join_key("ADSL", "ADTTE", c("STUDYID", "USUBJID")), + join_key("ADSL", "ADAE", c("STUDYID", "USUBJID")), + join_key("ADTTE", "ADAE", c("STUDYID", "USUBJID")) + ) + jks$set_parents(list(ADSL = character(0), ADTTE = "ADSL", ADAE = "ADSL")) + testthat::expect_equal(data$get_join_keys(), jks) +}) + +testthat::test_that( + "cdisc_data sets the join_keys internally based on parents relations when primary keys are altered", { + jks <- join_keys(join_key("ADSL", "ADSL", c("STUDYID"))) + data <- cdisc_data_mixed_call(join_keys1 = jks) + + jks <- join_keys( + join_key("ADSL", "ADSL", c("STUDYID")), + join_key("ADTTE", "ADTTE", c("STUDYID", "USUBJID", "PARAMCD")), + join_key("ADAE", "ADAE", c("STUDYID", "USUBJID", "ASTDTM", "AETERM", "AESEQ")), + join_key("ADSL", "ADTTE", c("STUDYID")), + join_key("ADSL", "ADAE", c("STUDYID")), + join_key("ADTTE", "ADAE", c("STUDYID")) + ) + jks$set_parents(list(ADSL = character(0), ADTTE = "ADSL", ADAE = "ADSL")) + testthat::expect_equal( + data$get_join_keys(), + jks + ) +}) + +testthat::test_that("cdisc_data sets primary keys as join_keys when no join_keys are present", { + 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 <- cdisc_data(df1, df2, check = FALSE) + + jks <- join_keys( + join_key("df1", "df1", "id"), + join_key("df2", "df2", "df2_id") + ) + jks$set_parents(list(df1 = character(0), df2 = character(0))) + testthat::expect_equal(data$get_join_keys(), jks) +}) + +testthat::test_that("cdisc_data throws error when a parent/child graph is not correct", { + 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 <- cdisc_dataset("df1", df1, keys = "id", parent = "df1") + df2 <- cdisc_dataset("df2", df2, keys = "df2_id", parent = "df1") + + testthat::expect_error( + cdisc_data(df1, df2, check = FALSE), + "Cycle detected in a parent and child dataset graph." + ) +}) + +testthat::test_that("Basic example - without code and check", { + adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) + + testthat::expect_silent(cdisc_data(cdisc_dataset("ADSL", adsl_raw), code = "", check = FALSE)) + testthat::expect_silent(cdisc_data(cdisc_dataset("ADSL", adsl_raw), + cdisc_dataset("ARG1", adsl_raw, keys = get_cdisc_keys("ADSL")), + cdisc_dataset("ARG2", adsl_raw, keys = get_cdisc_keys("ADSL")), + code = "", check = FALSE + )) +}) + +testthat::test_that("Basic example - check overall code", { + adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) + + testthat::expect_silent( + cdisc_data( + cdisc_dataset("ADSL", adsl_raw), + cdisc_dataset("ARG1", adsl_raw, keys = get_cdisc_keys("ADSL")), + cdisc_dataset("ARG2", adsl_raw, keys = get_cdisc_keys("ADSL")), + code = "ADSL <- ARG1 <- ARG2 <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))", + check = TRUE + ) + ) + + testthat::expect_error( + cdisc_data( + cdisc_dataset( + "ADSL", + adsl_raw, + code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" + ), + cdisc_dataset("ARG1", adsl_raw, keys = get_cdisc_keys("ADSL")), + cdisc_dataset("ARG2", adsl_raw, keys = get_cdisc_keys("ADSL")), + code = "test", + check = TRUE + ), + "'code' argument should be specified only in the 'cdisc_data' or in 'cdisc_dataset' but not in both" + ) + + testthat::expect_error( + cdisc_data( + cdisc_dataset( + "ADSL", + adsl_raw, + code = "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" + ), + cdisc_dataset( + dataname = "ARG1", + x = dplyr::mutate(adsl_raw, x1 = 1), + keys = get_cdisc_keys("ADSL"), + code = "ARG1 <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" + ), + cdisc_dataset( + "ARG2", + adsl_raw, + keys = get_cdisc_keys("ADSL"), + code = "ARG2 <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))" + ), + check = TRUE + ), + "Reproducibility check failed." + ) +}) + +testthat::test_that("List values", { + 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")))) + + test_relational_data_equal <- function(data1, data2) { + testthat::expect_equal(data1$get_items(), data2$get_items()) + testthat::expect_equal(data1$get_join_keys(), data2$get_join_keys()) + mapply(testthat::expect_equal, data1$get_ui("test"), data2$get_ui("test")) + } + + result <- cdisc_data(cdisc_dataset("ADSL", adsl_raw, label = "test_label")) + + datasets <- list(cdisc_dataset( + dataname = "ADSL", + x = adsl_raw, + keys = c("STUDYID", "USUBJID"), + parent = character(0), + label = "test_label" + )) + + result_to_compare <- do.call(cdisc_data, datasets) + + test_relational_data_equal(result, result_to_compare) + + result <- cdisc_data(cdisc_dataset("ADSL", adsl_raw), cdisc_dataset("ADTTE", adtte_raw)) + + datasets <- list( + cdisc_dataset( + dataname = "ADSL", + x = adsl_raw, + keys = c("STUDYID", "USUBJID"), + parent = character(0), + label = character(0) + ), + cdisc_dataset( + dataname = "ADTTE", + x = adtte_raw, + keys = c("STUDYID", "USUBJID", "PARAMCD"), + parent = "ADSL", + label = character(0) + ) + ) + + result_to_compare <- do.call("cdisc_data", datasets) + + test_relational_data_equal(result, result_to_compare) +}) + +testthat::test_that("cdisc_data_file loads the TealData object", { + rlang::local_options(lifecycle_verbosity = "quiet") + + tmp_file <- tempfile(fileext = ".R") + writeLines(text = c( + "adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys('ADSL')))) + adsl <- cdisc_dataset( + dataname = 'ADSL', + x = adsl_raw, + code = 'ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))' + ) + cdisc_data(adsl) + " + ), + con = tmp_file + ) + tdf <- cdisc_data_file(tmp_file) + file.remove(tmp_file) + testthat::expect_s3_class(tdf, "TealData") + testthat::expect_identical( + tdf$get_code(), + paste0( + "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", + "adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n", + "adsl <- cdisc_dataset(dataname = \"ADSL\", x = adsl_raw, ", + "code = \"ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\\\"ADSL\\\"))))\")\n", + "cdisc_data(adsl)" + ) + ) +}) + +testthat::test_that("cdisc_data_file uses the code input to mutate the code of the loaded TealData object", { + rlang::local_options(lifecycle_verbosity = "quiet") + + tmp_file <- tempfile(fileext = ".R") + writeLines(text = c( + "adsl_raw <- as.data.frame(as.list(setNames(nm = get_cdisc_keys('ADSL')))) + adsl <- cdisc_dataset( + dataname = 'ADSL', + x = adsl_raw, + code = 'ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))' + ) + cdisc_data(adsl) + " + ), + con = tmp_file + ) + tdf <- cdisc_data_file(tmp_file, "# MUTATE code") + file.remove(tmp_file) + testthat::expect_s3_class(tdf, "TealData") + testthat::expect_identical( + tdf$get_code(), + "ADSL <- as.data.frame(as.list(setNames(nm = get_cdisc_keys(\"ADSL\"))))\n# MUTATE code" + ) +}) diff --git a/tests/testthat/test-data_label.R b/tests/testthat/test-data_label.R index 0251c46bf..80f231d10 100644 --- a/tests/testthat/test-data_label.R +++ b/tests/testthat/test-data_label.R @@ -41,3 +41,15 @@ testthat::test_that("get_labels' column_labels is a named vector of the labels o 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-teal_data.R b/tests/testthat/test-teal_data.R index e07ccdb2a..2da57165c 100644 --- a/tests/testthat/test-teal_data.R +++ b/tests/testthat/test-teal_data.R @@ -1,5 +1,111 @@ -testthat::test_that("teal_data returns CDISCTealData object rather than TealData - object when arguments contain any type of a CDISCTealData object", { +teal_data_mixed_call <- function(check = TRUE, join_keys1 = join_keys()) { + df1 <- data.frame(AA = c(1, 2, 3), BB = c("A", "B", "C")) + df2 <- data.frame(AA = c(4, 5, 6), BB = c("A", "B", "C")) + df3 <- data.frame(AA = c(7, 8, 9), BB = c("A", "B", "C")) + + df1_ds <- dataset( + dataname = "df1", + x = df1, + code = "df1 <- data.frame(AA = c(1,2,3), BB = c(\"A\", \"B\", \"C\"))" + ) + + df2_cf <- callable_function( + function() { + data.frame(A = c(4, 5, 6), BB = c("A", "B", "C")) + } + ) + df2_dc <- dataset_connector("df2", df2_cf) + + df3_cf <- callable_function( + function() { + data.frame(AA = c(7, 8, 9), BB = c("A", "B", "C")) + } + ) + df3_cdc <- dataset_connector("df3", df3_cf) + df3_rdc <- relational_data_connector( + connection = data_connection(open_fun = callable_function(function() "open function")), + connectors = list(df3_cdc) + ) + + load_dataset(df1_ds) + load_dataset(df2_dc) + load_dataset(df3_cdc) + + teal_data(df1_ds, df2_dc, df3_rdc, check = check, join_keys = join_keys1) +} + +testthat::test_that("teal_data accepts TealDataset, TealDatasetConnector, TealDataConnector objects", { + testthat::expect_silent(data <- teal_data_mixed_call()) + testthat::expect_identical(data$get_datanames(), c("df1", "df2", "df3")) +}) + +testthat::test_that("teal_data throws error if it receives undesired objects", { + df1 <- data.frame(id = c("A", "B"), a = c(1L, 2L)) + + testthat::expect_error( + teal_data(df1, check = TRUE), + "May only contain the following types: \\{TealDataset,TealDatasetConnector,TealDataConnector\\}" + ) +}) + +testthat::test_that("teal_data sets passed join_keys to datasets correctly", { + 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 <- teal_data(df1, df2, join_keys = jk, check = FALSE) + + testthat::expect_equal( + data$get_join_keys(), + join_keys( + join_key("df1", "df2", "id"), + join_key("df1", "df1", "id"), + join_key("df2", "df2", "df2_id") + ) + ) +}) + +testthat::test_that("teal_data sets passed JoinKeys to datasets correctly when key names differ", { + 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") + jk <- join_keys(join_key("df1", "df2", c(id = "fk"))) + data <- teal_data(df1, df2, join_keys = jk, check = FALSE) + + testthat::expect_equal( + data$get_join_keys(), + join_keys( + join_key("df1", "df2", c(id = "fk")), + join_key("df1", "df1", "id"), + join_key("df2", "df1", c(fk = "id")), + join_key("df2", "df2", "df2_id") + ) + ) +}) + +testthat::test_that("teal_data sets passes JoinKeys to datasets correctly when key names differ (multiple keys)", { + df1 <- data.frame(id = c("A", "B"), id2 = c("A", "B"), a = c(1L, 2L)) + df2 <- data.frame(df2_id = c("A", "B"), fk = c("A", "B"), fk2 = c("A", "B"), b = c(1L, 2L)) + df1 <- dataset("df1", df1, keys = "id") + df2 <- dataset("df2", df2, keys = "df2_id") + data <- teal_data(df1, df2, check = FALSE) + data$mutate_join_keys("df1", "df2", c(id = "fk", id2 = "fk2")) + + testthat::expect_equal( + data$get_join_keys(), + join_keys( + join_key("df1", "df1", "id"), + join_key("df2", "df2", "df2_id"), + join_key("df1", "df2", c(id = "fk", id2 = "fk2")) + ) + ) +}) + +testthat::test_that("teal_data returns TealData object with cdisc_dataset input", { dummy_adsl <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADSL")))) adsl <- cdisc_dataset("ADSL", dummy_adsl) dummy_adtte <- as.data.frame(as.list(setNames(nm = get_cdisc_keys("ADTTE")))) @@ -12,7 +118,7 @@ testthat::test_that("teal_data returns CDISCTealData object rather than TealData mae <- MAETealDataset$new("MAE", dummy_mae) mixed_data <- teal_data(mae, adsl, adtte, ds2) - testthat::expect_equal(class(mixed_data), c("CDISCTealData", "TealData", "TealDataAbstract", "R6")) + testthat::expect_equal(class(mixed_data), c("TealData", "TealDataAbstract", "R6")) mae_only <- teal_data(mae) testthat::expect_equal(class(mae_only), c("TealData", "TealDataAbstract", "R6")) @@ -24,9 +130,110 @@ testthat::test_that("teal_data returns CDISCTealData object rather than TealData testthat::expect_equal(class(mae_and_dataset), c("TealData", "TealDataAbstract", "R6")) cdisc_only <- teal_data(adsl, adtte) - testthat::expect_equal(class(cdisc_only), c("CDISCTealData", "TealData", "TealDataAbstract", "R6")) + testthat::expect_equal(class(cdisc_only), c("TealData", "TealDataAbstract", "R6")) testthat::expect_error( teal_data() ) }) + +testthat::test_that("teal_data_file loads the TealData object", { + tmp_file <- tempfile(fileext = ".R") + writeLines(text = c( + "df <- data.frame(A = c(1, 2, 3)) + df1_ds <- dataset('df', df, code = 'df <- data.frame(A = c(1, 2, 3))') + teal_data(df1_ds) + " + ), + con = tmp_file + ) + tdf <- teal_data_file(tmp_file) + file.remove(tmp_file) + testthat::expect_s3_class(tdf, "TealData") + testthat::expect_identical( + tdf$get_code(), + paste0( + "df <- data.frame(A = c(1, 2, 3))\n", + "df1_ds <- dataset(\"df\", df, code = \"df <- data.frame(A = c(1, 2, 3))\")\n", + "teal_data(df1_ds)" + ) + ) +}) + +testthat::test_that("teal_data_file uses the code input to mutate the code of the loaded TealData object", { + tmp_file <- tempfile(fileext = ".R") + writeLines(text = c( + "df <- data.frame(A = c(1, 2, 3)) + df1_ds <- dataset('df', df, code = 'df <- data.frame(A = c(1, 2, 3))') + teal_data(df1_ds) + " + ), + con = tmp_file + ) + tdf <- teal_data_file(tmp_file, "# MUTATE code") + file.remove(tmp_file) + testthat::expect_identical(tdf$get_code(), "df <- data.frame(A = c(1, 2, 3))\n# MUTATE code") +}) + +testthat::test_that("update_join_keys_to_primary updates the 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") + + jks <- join_keys(join_key("df1", "df2", "id")) + data_objects <- list(df1, df2) + + update_join_keys_to_primary(data_objects, jks) + testthat::expect_equal( + jks, + join_keys( + join_key("df1", "df2", "id"), + join_key("df1", "df1", "id"), + join_key("df2", "df2", "df2_id") + ) + ) +}) + +testthat::test_that("update_join_keys_to_primary updates the join_keys when primary keys exist", { + 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") + + jks <- join_keys(join_key("df1", "df2", "id")) + data_objects <- list(df1, df2) + + update_join_keys_to_primary(data_objects, jks) + testthat::expect_equal( + jks, + join_keys( + join_key("df1", "df2", "id"), + join_key("df1", "df1", "id"), + join_key("df2", "df2", "df2_id") + ) + ) +}) + +testthat::test_that("update_join_keys_to_primary updates join_keys with character(0) when no primary keys exist", { + 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) + df2 <- dataset("df2", df2) + + jks <- join_keys(join_key("df1", "df2", "id")) + data_objects <- list(df1, df2) + + update_join_keys_to_primary(data_objects, jks) + testthat::expect_equal( + jks, + join_keys( + join_key("df1", "df2", "id"), + join_key("df1", "df1", character(0)), + join_key("df2", "df2", character(0)) + ) + ) +})