From 0acc30e99c41fe74930aec3d7e1a52ff0884b752 Mon Sep 17 00:00:00 2001 From: Pawel Rucki <12943682+pawelru@users.noreply.github.com> Date: Thu, 22 Feb 2024 13:06:26 +0100 Subject: [PATCH] options for strict tests; few enhancements --- DESCRIPTION | 7 ++-- R/choices_labeled.R | 8 ++--- R/choices_selected.R | 2 +- R/data_extract_module.R | 9 +---- R/data_extract_spec.R | 1 - R/format_data_extract.R | 1 + R/resolve.R | 2 +- R/resolve_delayed.R | 3 +- R/utils.R | 7 +--- README.md | 2 +- man/choices_labeled.Rd | 4 +-- man/choices_selected.Rd | 2 +- man/compose_and_enable_validators.Rd | 7 +--- man/data_extract_multiple_srv.Rd | 7 +--- man/data_extract_spec.Rd | 1 - man/data_extract_srv.Rd | 1 - man/data_extract_ui.Rd | 1 - man/format_data_extract.Rd | 1 + man/resolve_delayed.Rd | 3 +- man/value_choices.Rd | 2 +- man/variable_choices.Rd | 2 +- tests/testthat/setup-logger.R | 1 + tests/testthat/setup-options.R | 20 +++++++++++ tests/testthat/test-data_extract_module.R | 4 +-- .../testthat/test-data_extract_multiple_srv.R | 6 ++-- tests/testthat/test-data_extract_spec.R | 4 +-- tests/testthat/test-data_extract_srv.R | 15 +++----- tests/testthat/test-delayed_data_extract.R | 8 ++--- tests/testthat/test-dplyr_call_examples.R | 2 +- tests/testthat/test-filter_spec.R | 10 +++--- .../testthat/test-get_filter_call-datasets.R | 34 +++++++++---------- tests/testthat/test-resolve.R | 4 +-- tests/testthat/test-resolve_delayed.R | 16 ++++----- tests/testthat/test-select_spec.R | 4 +-- tests/testthat/test-value_choices.R | 4 +-- tests/testthat/test-variable_choices.R | 4 +-- vignettes/data-extract-merge.Rmd | 4 +-- vignettes/data-extract.Rmd | 10 +++--- vignettes/data-merge.Rmd | 12 +++---- 39 files changed, 114 insertions(+), 121 deletions(-) create mode 100644 tests/testthat/setup-logger.R create mode 100644 tests/testthat/setup-options.R diff --git a/DESCRIPTION b/DESCRIPTION index 6f644e27..960df9a7 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -40,17 +40,18 @@ Suggests: knitr (>= 1.42), rmarkdown (>= 2.19), teal.code (>= 0.5.0), - testthat (>= 3.1.5) + testthat (>= 3.1.5), + withr (>= 2.0.0) VignetteBuilder: knitr RdMacros: lifecycle Config/Needs/verdepcheck: mllg/checkmate, tidyverse/dplyr, - r-lib/lifecycle, daroczig/logger, r-lib/rlang, rstudio/rmarkdown, + r-lib/lifecycle, daroczig/logger, r-lib/rlang, rstudio/shiny, daattali/shinyjs, rstudio/shinyvalidate, insightsengineering/teal.data, insightsengineering/teal.logger, insightsengineering/teal.widgets, tidyverse/tidyr, r-lib/tidyselect, - yihui/knitr, insightsengineering/teal.code, r-lib/testthat + yihui/knitr, rstudio/rmarkdown, insightsengineering/teal.code, r-lib/testthat, r-lib/withr Config/Needs/website: insightsengineering/nesttemplate Encoding: UTF-8 Language: en-US diff --git a/R/choices_labeled.R b/R/choices_labeled.R index 066e0347..aefc8575 100644 --- a/R/choices_labeled.R +++ b/R/choices_labeled.R @@ -26,8 +26,8 @@ #' library(shiny) #' library(teal.data) #' -#' ADSL <- teal.transform::rADSL -#' ADTTE <- teal.transform::rADTTE +#' ADSL <- rADSL +#' ADTTE <- rADTTE #' #' choices1 <- choices_labeled(names(ADSL), col_labels(ADSL, fill = FALSE)) #' choices2 <- choices_labeled(ADTTE$PARAMCD, ADTTE$PARAM) @@ -152,7 +152,7 @@ choices_labeled <- function(choices, labels, subset = NULL, types = NULL) { #' @examples #' library(teal.data) #' -#' ADRS <- teal.transform::rADRS +#' ADRS <- rADRS #' variable_choices(ADRS) #' variable_choices(ADRS, subset = c("PARAM", "PARAMCD")) #' variable_choices(ADRS, subset = c("", "PARAM", "PARAMCD")) @@ -267,7 +267,7 @@ variable_choices.data.frame <- function(data, subset = NULL, fill = TRUE, key = #' @return named character vector or `delayed_data` object. #' #' @examples -#' ADRS <- teal.transform::rADRS +#' ADRS <- rADRS #' value_choices(ADRS, "PARAMCD", "PARAM", subset = c("BESRSPI", "INVET")) #' value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM")) #' value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM"), diff --git a/R/choices_selected.R b/R/choices_selected.R index a453948a..7cb6ed5d 100644 --- a/R/choices_selected.R +++ b/R/choices_selected.R @@ -50,7 +50,7 @@ no_select_keyword <- "-- no selection --" #' selected = "C" #' ) #' -#' ADSL <- teal.transform::rADSL +#' ADSL <- rADSL #' choices_selected(variable_choices(ADSL), "SEX") #' #' # How to select nothing diff --git a/R/data_extract_module.R b/R/data_extract_module.R index 39c0a9dc..e079ce1a 100644 --- a/R/data_extract_module.R +++ b/R/data_extract_module.R @@ -119,7 +119,6 @@ cond_data_extract_single_ui <- function(ns, single_data_extract_spec) { #' ) #' ) #' ) -#' #' @export #' data_extract_ui <- function(id, label, data_extract_spec, is_single_dataset = FALSE) { @@ -391,7 +390,6 @@ check_data_extract_spec_react <- function(datasets, data_extract) { #' if (interactive()) { #' shinyApp(ui, server) #' } -#' #' @export #' data_extract_srv <- function(id, datasets, data_extract_spec, ...) { @@ -635,11 +633,6 @@ data_extract_srv.list <- function(id, #' ) #' #' server <- function(input, output, session) { -#' exactly_2_validation <- function(msg) { -#' ~ if (length(.) != 2) msg -#' } -#' -#' #' selector_list <- data_extract_multiple_srv( #' list(x_var = iris_select, species_var = iris_filter), #' datasets = data_list, @@ -649,7 +642,7 @@ data_extract_srv.list <- function(id, #' filter_validation_rule = list( #' species_var = compose_rules( #' sv_required("Exactly 2 Species must be chosen"), -#' exactly_2_validation("Exactly 2 Species must be chosen") +#' function(x) if (length(x) != 2) "Exactly 2 Species must be chosen" #' ) #' ) #' ) diff --git a/R/data_extract_spec.R b/R/data_extract_spec.R index 04d29d36..517f2861 100644 --- a/R/data_extract_spec.R +++ b/R/data_extract_spec.R @@ -81,7 +81,6 @@ #' dataname = "ADSL", #' filter = dynamic_filter #' ) -#' #' @export #' data_extract_spec <- function(dataname, select = NULL, filter = NULL, reshape = FALSE) { diff --git a/R/format_data_extract.R b/R/format_data_extract.R index 1de543bb..8cff79e9 100644 --- a/R/format_data_extract.R +++ b/R/format_data_extract.R @@ -11,6 +11,7 @@ #' #' @examples #' library(shiny) +#' #' simple_des <- data_extract_spec( #' dataname = "iris", #' filter = filter_spec(vars = "Petal.Length", choices = c("1.4", "1.5")), diff --git a/R/resolve.R b/R/resolve.R index d738e28d..e4072a89 100644 --- a/R/resolve.R +++ b/R/resolve.R @@ -60,7 +60,7 @@ resolve.delayed_choices_selected <- function(x, datasets, keys) { x$choices <- resolve(x$choices, datasets = datasets, keys) if (!all(x$selected %in% x$choices)) { - logger::log_warn(paste( + warning(paste( "Removing", paste(x$selected[which(!x$selected %in% x$choices)]), "from 'selected' as not in 'choices' when resolving delayed choices_selected" diff --git a/R/resolve_delayed.R b/R/resolve_delayed.R index 96b0fb9a..b6ec8ece 100644 --- a/R/resolve_delayed.R +++ b/R/resolve_delayed.R @@ -11,7 +11,8 @@ #' #' @examples #' library(shiny) -#' ADSL <- teal.transform::rADSL +#' +#' ADSL <- rADSL #' isolate({ #' data_list <- list(ADSL = reactive(ADSL)) #' diff --git a/R/utils.R b/R/utils.R index 620bfe3e..f9f26fa1 100644 --- a/R/utils.R +++ b/R/utils.R @@ -107,10 +107,6 @@ extract_choices_labels <- function(choices, values = NULL) { #' ) #' #' server <- function(input, output, session) { -#' exactly_2_validation <- function() { -#' ~ if (length(.) != 2) "Exactly 2 'Y' column variables must be chosen" -#' } -#' #' selector_list <- data_extract_multiple_srv( #' list(x_var = iris_extract, y_var = iris_extract, col_var = iris_extract), #' datasets = data_list, @@ -118,7 +114,7 @@ extract_choices_labels <- function(choices, values = NULL) { #' x_var = sv_required("Please select an X column"), #' y_var = compose_rules( #' sv_required("Exactly 2 'Y' column variables must be chosen"), -#' exactly_2_validation() +#' function(x) if (length(x) != 2) "Exactly 2 'Y' column variables must be chosen" #' ) #' ) #' ) @@ -147,7 +143,6 @@ extract_choices_labels <- function(choices, values = NULL) { #' if (interactive()) { #' shinyApp(ui, server) #' } -#' #' @export #' compose_and_enable_validators <- function(iv, selector_list, validator_names = NULL) { diff --git a/README.md b/README.md index 3824c993..18652122 100644 --- a/README.md +++ b/README.md @@ -54,7 +54,7 @@ Below is a small example usage: ```r library(teal.transform) -ADSL <- teal.transform::rADSL +ADSL <- rADSL adsl_extract <- data_extract_spec( dataname = "ADSL", diff --git a/man/choices_labeled.Rd b/man/choices_labeled.Rd index 50bfe012..f1a9be18 100644 --- a/man/choices_labeled.Rd +++ b/man/choices_labeled.Rd @@ -49,8 +49,8 @@ Duplicated elements from \code{choices} get removed. library(shiny) library(teal.data) -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE choices1 <- choices_labeled(names(ADSL), col_labels(ADSL, fill = FALSE)) choices2 <- choices_labeled(ADTTE$PARAMCD, ADTTE$PARAM) diff --git a/man/choices_selected.Rd b/man/choices_selected.Rd index 33682b8a..c3fdaa24 100644 --- a/man/choices_selected.Rd +++ b/man/choices_selected.Rd @@ -75,7 +75,7 @@ choices_selected( selected = "C" ) -ADSL <- teal.transform::rADSL +ADSL <- rADSL choices_selected(variable_choices(ADSL), "SEX") # How to select nothing diff --git a/man/compose_and_enable_validators.Rd b/man/compose_and_enable_validators.Rd index 3076274f..851c89df 100644 --- a/man/compose_and_enable_validators.Rd +++ b/man/compose_and_enable_validators.Rd @@ -70,10 +70,6 @@ ui <- fluidPage( ) server <- function(input, output, session) { - exactly_2_validation <- function() { - ~ if (length(.) != 2) "Exactly 2 'Y' column variables must be chosen" - } - selector_list <- data_extract_multiple_srv( list(x_var = iris_extract, y_var = iris_extract, col_var = iris_extract), datasets = data_list, @@ -81,7 +77,7 @@ server <- function(input, output, session) { x_var = sv_required("Please select an X column"), y_var = compose_rules( sv_required("Exactly 2 'Y' column variables must be chosen"), - exactly_2_validation() + function(x) if (length(x) != 2) "Exactly 2 'Y' column variables must be chosen" ) ) ) @@ -110,5 +106,4 @@ server <- function(input, output, session) { if (interactive()) { shinyApp(ui, server) } - } diff --git a/man/data_extract_multiple_srv.Rd b/man/data_extract_multiple_srv.Rd index 6aa3a9d7..bf77550a 100644 --- a/man/data_extract_multiple_srv.Rd +++ b/man/data_extract_multiple_srv.Rd @@ -123,11 +123,6 @@ ui <- fluidPage( ) server <- function(input, output, session) { - exactly_2_validation <- function(msg) { - ~ if (length(.) != 2) msg - } - - selector_list <- data_extract_multiple_srv( list(x_var = iris_select, species_var = iris_filter), datasets = data_list, @@ -137,7 +132,7 @@ server <- function(input, output, session) { filter_validation_rule = list( species_var = compose_rules( sv_required("Exactly 2 Species must be chosen"), - exactly_2_validation("Exactly 2 Species must be chosen") + function(x) if (length(x) != 2) "Exactly 2 Species must be chosen" ) ) ) diff --git a/man/data_extract_spec.Rd b/man/data_extract_spec.Rd index 02cf0e90..867c82b1 100644 --- a/man/data_extract_spec.Rd +++ b/man/data_extract_spec.Rd @@ -91,7 +91,6 @@ data_extract_spec( dataname = "ADSL", filter = dynamic_filter ) - } \references{ \link{select_spec} \link{filter_spec} diff --git a/man/data_extract_srv.Rd b/man/data_extract_srv.Rd index ae9ea933..f5a5c969 100644 --- a/man/data_extract_srv.Rd +++ b/man/data_extract_srv.Rd @@ -180,7 +180,6 @@ server <- function(input, output, session) { if (interactive()) { shinyApp(ui, server) } - } \references{ \link{data_extract_srv} diff --git a/man/data_extract_ui.Rd b/man/data_extract_ui.Rd index 749ea3f1..93f0c989 100644 --- a/man/data_extract_ui.Rd +++ b/man/data_extract_ui.Rd @@ -82,5 +82,4 @@ standard_layout( ) ) ) - } diff --git a/man/format_data_extract.Rd b/man/format_data_extract.Rd index 0aeac371..62d03c73 100644 --- a/man/format_data_extract.Rd +++ b/man/format_data_extract.Rd @@ -21,6 +21,7 @@ See the example for more information. } \examples{ library(shiny) + simple_des <- data_extract_spec( dataname = "iris", filter = filter_spec(vars = "Petal.Length", choices = c("1.4", "1.5")), diff --git a/man/resolve_delayed.Rd b/man/resolve_delayed.Rd index 6f9dc400..25d0444c 100644 --- a/man/resolve_delayed.Rd +++ b/man/resolve_delayed.Rd @@ -39,7 +39,8 @@ Resolved object. }} \examples{ library(shiny) -ADSL <- teal.transform::rADSL + +ADSL <- rADSL isolate({ data_list <- list(ADSL = reactive(ADSL)) diff --git a/man/value_choices.Rd b/man/value_choices.Rd index a4b631f4..40286919 100644 --- a/man/value_choices.Rd +++ b/man/value_choices.Rd @@ -39,7 +39,7 @@ named character vector or \code{delayed_data} object. Wrapper on \link{choices_labeled} to label variable values basing on other variable values. } \examples{ -ADRS <- teal.transform::rADRS +ADRS <- rADRS value_choices(ADRS, "PARAMCD", "PARAM", subset = c("BESRSPI", "INVET")) value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM")) value_choices(ADRS, c("PARAMCD", "ARMCD"), c("PARAM", "ARM"), diff --git a/man/variable_choices.Rd b/man/variable_choices.Rd index 18617ad8..b69b069b 100644 --- a/man/variable_choices.Rd +++ b/man/variable_choices.Rd @@ -45,7 +45,7 @@ Wrapper on \link{choices_labeled} to label variables basing on existing labels i \examples{ library(teal.data) -ADRS <- teal.transform::rADRS +ADRS <- rADRS variable_choices(ADRS) variable_choices(ADRS, subset = c("PARAM", "PARAMCD")) variable_choices(ADRS, subset = c("", "PARAM", "PARAMCD")) diff --git a/tests/testthat/setup-logger.R b/tests/testthat/setup-logger.R new file mode 100644 index 00000000..1a7b3e5c --- /dev/null +++ b/tests/testthat/setup-logger.R @@ -0,0 +1 @@ +logger::log_appender(function(...) {}, namespace = "teal") diff --git a/tests/testthat/setup-options.R b/tests/testthat/setup-options.R new file mode 100644 index 00000000..78be1f9b --- /dev/null +++ b/tests/testthat/setup-options.R @@ -0,0 +1,20 @@ +# `opts_partial_match_old` is left for exclusions due to partial matching in dependent packages (i.e. not fixable here) +# it might happen that it is not used right now, but it is left for possible future use +# use with: `withr::with_options(opts_partial_match_old, { ... })` inside the test +opts_partial_match_old <- list( + warnPartialMatchDollar = getOption("warnPartialMatchDollar"), + warnPartialMatchArgs = getOption("warnPartialMatchArgs"), + warnPartialMatchAttr = getOption("warnPartialMatchAttr") +) +opts_partial_match_new <- list( + warnPartialMatchDollar = TRUE, + warnPartialMatchArgs = TRUE, + warnPartialMatchAttr = TRUE +) + +if (isFALSE(getFromNamespace("on_cran", "testthat")()) && requireNamespace("withr", quietly = TRUE)) { + withr::local_options( + opts_partial_match_new, + .local_envir = testthat::teardown_env() + ) +} diff --git a/tests/testthat/test-data_extract_module.R b/tests/testthat/test-data_extract_module.R index a9deb39a..55df2e99 100644 --- a/tests/testthat/test-data_extract_module.R +++ b/tests/testthat/test-data_extract_module.R @@ -1,5 +1,5 @@ -ADLB <- teal.transform::rADLB -ADTTE <- teal.transform::rADTTE +ADLB <- rADLB +ADTTE <- rADTTE testthat::test_that("Single filter", { data_extract <- data_extract_spec( diff --git a/tests/testthat/test-data_extract_multiple_srv.R b/tests/testthat/test-data_extract_multiple_srv.R index a4d7fe73..6d3bcca1 100644 --- a/tests/testthat/test-data_extract_multiple_srv.R +++ b/tests/testthat/test-data_extract_multiple_srv.R @@ -1,6 +1,6 @@ -ADSL <- teal.transform::rADSL -ADLB <- teal.transform::rADLB -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADLB <- rADLB +ADTTE <- rADTTE data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADLB = reactive(ADLB)) join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADLB")] diff --git a/tests/testthat/test-data_extract_spec.R b/tests/testthat/test-data_extract_spec.R index 8ec25a57..b3c05043 100644 --- a/tests/testthat/test-data_extract_spec.R +++ b/tests/testthat/test-data_extract_spec.R @@ -1,5 +1,5 @@ -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE)) key_list <- list(ADSL = c("STUDYID", "USUBJID"), ADTTE = c("STUDYID", "USUBJID", "PARAMCD")) diff --git a/tests/testthat/test-data_extract_srv.R b/tests/testthat/test-data_extract_srv.R index 0fabba21..433e1905 100644 --- a/tests/testthat/test-data_extract_srv.R +++ b/tests/testthat/test-data_extract_srv.R @@ -1,6 +1,6 @@ -ADSL <- teal.transform::rADSL -ADLB <- teal.transform::rADLB -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADLB <- rADLB +ADTTE <- rADTTE data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADLB = reactive(ADLB)) join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADLB")] @@ -493,7 +493,7 @@ testthat::test_that("select validation accepts function as validator", { datasets = data_list, data_extract_spec = adsl_extract, join_keys = join_keys, - select_validation_rule = ~ if (nchar(.) == 0) "error" + select_validation_rule = function(x) if (nchar(x) == 0) "error" ) iv_r <- reactive({ @@ -547,11 +547,6 @@ testthat::test_that("data_extract_multiple_srv input validation", { data_list <- list(iris = reactive(iris)) server <- function(input, output, session) { - exactly_2_validation <- function(msg) { - ~ if (length(.) != 2) msg - } - - selector_list <- data_extract_multiple_srv( list(x_var = iris_select, species_var = iris_filter), datasets = data_list, @@ -561,7 +556,7 @@ testthat::test_that("data_extract_multiple_srv input validation", { filter_validation_rule = list( species_var = shinyvalidate::compose_rules( shinyvalidate::sv_required("Exactly 2 Species must be chosen"), - exactly_2_validation("Exactly 2 Species must be chosen") + function(x) if (length(x) != 2) "Exactly 2 Species must be chosen" ) ) ) diff --git a/tests/testthat/test-delayed_data_extract.R b/tests/testthat/test-delayed_data_extract.R index d328dbe8..b0751256 100644 --- a/tests/testthat/test-delayed_data_extract.R +++ b/tests/testthat/test-delayed_data_extract.R @@ -1,9 +1,9 @@ # Contains integration tests between delayed data loading objects and # the objects responsible for loading, pulling and filtering the data -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE -ADAE <- teal.transform::rADAE -ADRS <- teal.transform::rADRS +ADSL <- rADSL +ADTTE <- rADTTE +ADAE <- rADAE +ADRS <- rADRS data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADAE = reactive(ADAE), ADRS = reactive(ADRS)) join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADAE", "ADRS")] diff --git a/tests/testthat/test-dplyr_call_examples.R b/tests/testthat/test-dplyr_call_examples.R index 6239ef5d..be040516 100644 --- a/tests/testthat/test-dplyr_call_examples.R +++ b/tests/testthat/test-dplyr_call_examples.R @@ -3361,7 +3361,7 @@ testthat::test_that("Universal example", { merged_datasets <- isolate( merge_datasets( selector_list = selector_list, - dataset = data_list, + datasets = data_list, join_keys = join_keys, merge_function = "dplyr::left_join", anl_name = "ANL" diff --git a/tests/testthat/test-filter_spec.R b/tests/testthat/test-filter_spec.R index ff54caea..628ac844 100644 --- a/tests/testthat/test-filter_spec.R +++ b/tests/testthat/test-filter_spec.R @@ -1,5 +1,5 @@ -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE), ADLB = reactive(ADLB)) join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE", "ADLB")] primary_keys_list <- lapply(join_keys, function(x) x[[1]]) @@ -218,7 +218,7 @@ testthat::test_that("filter_spec_internal", { }) testthat::test_that("filter_spec_internal contains dataname", { - ADSL <- teal.transform::rADSL + ADSL <- rADSL x_filter <- filter_spec_internal( vars_choices = variable_choices(ADSL) @@ -354,7 +354,7 @@ testthat::test_that("delayed version of filter_spec", { ) ) - res_obj <- isolate(resolve(obj, datasets = data_list, key = primary_keys_list)) + res_obj <- isolate(resolve(obj, datasets = data_list, keys = primary_keys_list)) exp_obj <- filter_spec( vars = variable_choices(ADSL, subset = "ARMCD"), choices = value_choices(ADSL, var_choices = "ARMCD", var_label = "ARM", subset = c("ARM A", "ARM B")), @@ -426,7 +426,7 @@ testthat::test_that("delayed version of filter_spec", { ) ) - res_obj <- isolate(resolve(obj, datasets = data_list, key = primary_keys_list)) + res_obj <- isolate(resolve(obj, datasets = data_list, keys = primary_keys_list)) # comparison not implemented, must be done individually testthat::expect_equal(res_obj$choices, exp_obj$choices) diff --git a/tests/testthat/test-get_filter_call-datasets.R b/tests/testthat/test-get_filter_call-datasets.R index fbdc6709..6bab08b1 100644 --- a/tests/testthat/test-get_filter_call-datasets.R +++ b/tests/testthat/test-get_filter_call-datasets.R @@ -20,7 +20,7 @@ testthat::test_that("get_filter_call throws error if dataset is not a named list testthat::expect_error( get_filter_call(filter = list( list(columns = "SEX", selected = list(NA)) - ), dataname = "ADAMSET", data = list(ADAMSET = data_small)), + ), dataname = "ADAMSET", datasets = list(ADAMSET = data_small)), "May only contain the following types: {reactive}, but element 1 has type 'data.frame'.", fixed = TRUE ) @@ -30,7 +30,7 @@ testthat::test_that("get_filter_call - data - NAs and one column - one selection testthat::expect_equal( isolate(get_filter_call(filter = list( list(columns = "SEX", selected = list(NA)) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter(is.na(SEX)) ) @@ -41,7 +41,7 @@ testthat::test_that("get_filter_call - data - NAs and one column - two selection testthat::expect_equal( isolate(get_filter_call(filter = list( list(columns = "SEX", selected = list(NA, "F")) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter(SEX %in% c(NA_character_, "F")) ) @@ -52,7 +52,7 @@ testthat::test_that("get_filter_call - data - NAs and two columns", { testthat::expect_equal( isolate(get_filter_call(filter = list( list(columns = c("SEX", "AGE"), selected = list(c("F", "44"), c(NA, "33"))) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter((SEX == "F" & AGE == "44") | (is.na(SEX) & AGE == "33")) ) @@ -64,7 +64,7 @@ testthat::test_that("get_filter_call - data - some of factor levels and integer" isolate(get_filter_call(filter = list( list(columns = "SEX", selected = list("F")), list(columns = "AGE", selected = list("42", "35")) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter(SEX == "F" & AGE %in% c("42", "35")) ) @@ -75,7 +75,7 @@ testthat::test_that("get_filter_call - data - trunc POSIX and single column", { testthat::expect_equal( isolate(get_filter_call(filter = list( list(columns = "TRTSDTM", selected = list("2020-03-08 06:28:11")) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter(trunc(TRTSDTM) == "2020-03-08 06:28:11") ) @@ -89,7 +89,7 @@ testthat::test_that("get_filter_call - data - trunc POSIX and two columns", { c("2020-03-08 06:28:11", "33"), c("2020-03-09 06:28:11", NA) )) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter( (trunc(TRTSDTM) == "2020-03-08 06:28:11" & AGE == "33") | @@ -106,7 +106,7 @@ testthat::test_that("get_filter_call - data - SEX and two columns, SEX variable c("F", "33"), c("M", NA) )) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter((SEX == "F" & AGE == "33") | (SEX == "M" & is.na(AGE))) ) @@ -120,7 +120,7 @@ testthat::test_that("get_filter_call - data - three columns", { c("F", "33", NA), c("M", NA, NA) )) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter((SEX == "F" & AGE == "33" & is.na(DCSREAS)) | (SEX == "M" & is.na(AGE) & is.na(DCSREAS))) ) @@ -134,7 +134,7 @@ testthat::test_that("get_filter_call - data - non empty filter as NA is not sele "ADVERSE EVENT", "DEATH" )) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote(dplyr::filter(DCSREAS %in% c("ADVERSE EVENT", "DEATH"))) ) }) @@ -146,7 +146,7 @@ testthat::test_that("get_filter_call - FALSE if empty selection for single", { list(columns = "DCSREAS", selected = c()) ), dataname = "ADAMSET", - data = data_list + datasets = data_list )), quote(dplyr::filter(FALSE)) ) @@ -157,7 +157,7 @@ testthat::test_that("get_filter_call - data - all factor levels and integer", { isolate(get_filter_call(filter = list( list(columns = "SEX", selected = list("F", "M")), list(columns = "AGE", selected = list("42", "35")) - ), dataname = "ADAMSET", data = data_list)), + ), dataname = "ADAMSET", datasets = data_list)), quote( dplyr::filter(AGE %in% c("42", "35")) ) @@ -168,14 +168,14 @@ testthat::test_that("get_filter_call - data - empty filter as all levels and NA testthat::expect_null( isolate(get_filter_call(filter = list( list(columns = "DCSREAS", selected = c("ADVERSE EVENT", "DEATH", NA)) - ), dataname = "ADAMSET", data = data_list)) + ), dataname = "ADAMSET", datasets = data_list)) ) }) testthat::test_that("get_filter_call - data - empty as all levels for SEX are selected - no missings", { testthat::expect_null( isolate(get_filter_call(filter = list( list(columns = "SEX", selected = list("F", "M")) - ), dataname = "ADAMSET", data = data_list)) + ), dataname = "ADAMSET", datasets = data_list)) ) }) @@ -189,7 +189,7 @@ testthat::test_that("get_filter_call - skip if all selected for single variable" ) ), dataname = "ADAMSET", - data = data_list + datasets = data_list )) ) }) @@ -204,7 +204,7 @@ testthat::test_that("get_filter_call - skip if all selected for multiple variabl ) ), dataname = "ADAMSET", - data = data_list + datasets = data_list )) ) }) @@ -219,7 +219,7 @@ testthat::test_that("get_filter_call - skip if all selected for multiple variabl ) ), dataname = "ADAMSET", - data = data_list + datasets = data_list )) ) }) diff --git a/tests/testthat/test-resolve.R b/tests/testthat/test-resolve.R index a68fd70f..73ca5627 100644 --- a/tests/testthat/test-resolve.R +++ b/tests/testthat/test-resolve.R @@ -1,5 +1,5 @@ -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE arm_ref_comp <- list( ARMCD = list( diff --git a/tests/testthat/test-resolve_delayed.R b/tests/testthat/test-resolve_delayed.R index ece8c286..27108e28 100644 --- a/tests/testthat/test-resolve_delayed.R +++ b/tests/testthat/test-resolve_delayed.R @@ -1,5 +1,5 @@ -adsl <- teal.transform::rADSL -adtte <- teal.transform::rADTTE +adsl <- rADSL +adtte <- rADTTE data_list <- list(ADSL = reactive(adsl), ADTTE = reactive(adtte)) join_keys <- teal.data::default_cdisc_join_keys[c("ADSL", "ADTTE")] @@ -150,14 +150,12 @@ testthat::test_that("resolving delayed choices removes selected not in choices a selected = variable_choices("IRIS", c("Petal.Length", "Sepal.Width")) ) - output <- testthat::capture_output({ - shiny::isolate({ + testthat::expect_warning( + output <- shiny::isolate({ resolved_cs <- resolve_delayed(c_s, datasets = list(IRIS = reactive(iris))) - }) - }) + }), + "Removing Petal.Length from 'selected' as not in 'choices' when resolving delayed choices_selected" + ) testthat::expect_equal(resolved_cs$selected, stats::setNames("Sepal.Width", "Sepal.Width: Sepal.Width")) - testthat::expect_true( - grepl("Removing Petal.Length from 'selected' as not in 'choices' when resolving delayed choices_selected", output) - ) }) diff --git a/tests/testthat/test-select_spec.R b/tests/testthat/test-select_spec.R index 41b5afa2..d3d99aa8 100644 --- a/tests/testthat/test-select_spec.R +++ b/tests/testthat/test-select_spec.R @@ -1,5 +1,5 @@ -adsl <- teal.transform::rADSL -adtte <- teal.transform::rADTTE +adsl <- rADSL +adtte <- rADTTE data_list <- list(ADSL = reactive(adsl), ADTTE = reactive(adtte)) primary_keys_list <- list(ADSL = c("STUDYID", "USUBJID"), ADTTE = c("STUDYID", "USUBJID", "PARAMCD")) diff --git a/tests/testthat/test-value_choices.R b/tests/testthat/test-value_choices.R index 94f2246d..411ec9ae 100644 --- a/tests/testthat/test-value_choices.R +++ b/tests/testthat/test-value_choices.R @@ -1,5 +1,5 @@ -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE)) primary_keys_list <- list(ADSL = c("STUDYID", "USUBJID"), ADTTE = c("STUDYID", "USUBJID", "PARAMCD")) diff --git a/tests/testthat/test-variable_choices.R b/tests/testthat/test-variable_choices.R index 74ca9825..df681046 100644 --- a/tests/testthat/test-variable_choices.R +++ b/tests/testthat/test-variable_choices.R @@ -1,5 +1,5 @@ -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE data_list <- list(ADSL = reactive(ADSL), ADTTE = reactive(ADTTE)) primary_keys_list <- list(ADSL = c("STUDYID", "USUBJID"), ADTTE = c("STUDYID", "USUBJID", "PARAMCD")) diff --git a/vignettes/data-extract-merge.Rmd b/vignettes/data-extract-merge.Rmd index dd34f573..3cba6b05 100644 --- a/vignettes/data-extract-merge.Rmd +++ b/vignettes/data-extract-merge.Rmd @@ -40,8 +40,8 @@ library(teal.data) library(shiny) # Define data.frame objects -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE # create a list of reactive data.frame objects datasets <- list( diff --git a/vignettes/data-extract.Rmd b/vignettes/data-extract.Rmd index 033b3eba..fc2e21f1 100644 --- a/vignettes/data-extract.Rmd +++ b/vignettes/data-extract.Rmd @@ -17,7 +17,7 @@ knitr::opts_chunk$set( ) ``` -With `teal`, app developers can open up their applications to users, allowing them to decide exactly which app data to +With `teal`, app developers can open up their applications to users, allowing them to decide exactly which app data to analyze within the module. A `teal` module can leverage the use of `data_extract_spec` objects to handle and process the user input. @@ -25,7 +25,7 @@ Examples can be found in the [modules from the `teal.modules.clinical` package]( ### `data_extract_spec` -The role of `data_extract_spec` is twofold: to create a UI component in a `shiny` application and to pass user input +The role of `data_extract_spec` is twofold: to create a UI component in a `shiny` application and to pass user input from the UI to a custom server logic that can use this input to transform the data. Let's delve into how it fulfills both of these responsibilities. @@ -37,8 +37,8 @@ library(teal.data) library(shiny) # Define data.frame objects -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE # create a list of reactive data.frame objects datasets <- list( @@ -71,7 +71,7 @@ simple_des <- data_extract_spec( To demonstrate different initialization options of `data_extract_spec`, let's first define a `shiny` module that utilizes `data_extract_ui` and `data_extract_srv` to handle `data_extract_spec` objects. -This module creates a UI component for a single `data_extract_spec` and prints a list of values returned from the `data_extract_srv` module. +This module creates a UI component for a single `data_extract_spec` and prints a list of values returned from the `data_extract_srv` module. For more information about `data_extract_ui` and `data_extract_srv`, please refer to the package documentation. ```{r} diff --git a/vignettes/data-merge.Rmd b/vignettes/data-merge.Rmd index 8552d7c0..622cf448 100644 --- a/vignettes/data-merge.Rmd +++ b/vignettes/data-merge.Rmd @@ -41,8 +41,8 @@ library(teal.data) library(shiny) # Define data.frame objects -ADSL <- teal.transform::rADSL -ADTTE <- teal.transform::rADTTE +ADSL <- rADSL +ADTTE <- rADTTE # create a list of reactive data.frame objects datasets <- list( @@ -157,7 +157,7 @@ shinyApp( ### `data_extract_multiple_srv` + `merge_expression_srv` In the scenario above, if the user deselects the `ADTTE` variable, the merging between `ADTTE` and `ADSL` would still occur, even though `ADTTE` is not used or needed. -Here, the developer might update the `selector_list` input in a reactive manner so that it gets updated based on conditions set by the developer. +Here, the developer might update the `selector_list` input in a reactive manner so that it gets updated based on conditions set by the developer. Below, we reuse the input from above and update the app server so that the `adtte_extract` is removed from the selector_list input when no `ADTTE` variable is selected. The `reactive_selector_list` is then passed to `merge_expression_srv`: @@ -224,8 +224,8 @@ These elements can be further used inside the server to retrieve and use informa ## Merging of non `CDISC` datasets -General datasets do not have the same relationships as `CDISC` datasets, so these relationships must be specified using the `join_keys` functions. +General datasets do not have the same relationships as `CDISC` datasets, so these relationships must be specified using the `join_keys` functions. For more information, please refer to the `Join Keys` [vignette](https://insightsengineering.github.io/teal.data/latest-tag/articles/join-keys). -The data merge module respects the relationships given by the user. -In the case of multiple datasets to merge, the order is specified by the order of elements in the `data_extract` argument of the `merge_expression_module` function. +The data merge module respects the relationships given by the user. +In the case of multiple datasets to merge, the order is specified by the order of elements in the `data_extract` argument of the `merge_expression_module` function. Merging groups of datasets with complex relationships can quickly become challenging to specify so please take extra care when setting this up.