diff --git a/DESCRIPTION b/DESCRIPTION index 6bb860a50c..4735155cca 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -31,7 +31,7 @@ BugReports: https://github.com/insightsengineering/teal/issues Depends: R (>= 4.0), shiny (>= 1.7.0), - teal.data (>= 0.3.0.9010), + teal.data (>= 0.3.0.9011), teal.slice (>= 0.4.0.9023), teal.transform (>= 0.4.0.9007) Imports: diff --git a/NEWS.md b/NEWS.md index 8926433360..49123b59c7 100644 --- a/NEWS.md +++ b/NEWS.md @@ -10,6 +10,7 @@ * Enhanced a `module` validation checks so that it won't throw messages about `data` argument unnecessarily. * Added argument to `teal_slices` and made modifications to `init` to enable tagging `teal_slices` with an app id to safely upload snapshots from disk. +* `FilteredData` no longer stores pre-processing code in specific slots. Code is now attached as attribute. Adjusted appropriately. ### Bug fixes diff --git a/R/get_rcode_utils.R b/R/get_rcode_utils.R index 610dbf01a5..e53bb9918a 100644 --- a/R/get_rcode_utils.R +++ b/R/get_rcode_utils.R @@ -38,28 +38,18 @@ get_rcode_str_install <- function() { #' @param datasets (`FilteredData`) object #' @param hashes named (`list`) of hashes per dataset #' -#' @return `character(3)` containing following elements: -#' - code from `CodeClass` (data loading code) +#' @return `character(3)` containing the following elements: +#' - data pre-processing code (from `data` argument in `init`) #' - hash check of loaded objects +#' - filter code #' #' @keywords internal get_datasets_code <- function(datanames, datasets, hashes) { - str_code <- datasets$get_code(datanames) - if (length(str_code) == 0 || (length(str_code) == 1 && str_code == "")) { - str_code <- "message('Preprocessing is empty')" - } else if (length(str_code) > 0) { - str_code <- paste0(str_code, "\n\n") - } - - if (!datasets$get_check()) { - check_note_string <- paste0( - c( - "message(paste(\"Reproducibility of data import and preprocessing was not explicitly checked\",", - " \" ('check = FALSE' is set). Contact app developer if this is an issue.\n\"))" - ), - collapse = "\n" - ) - str_code <- paste0(str_code, "\n\n", check_note_string) + str_prepro <- teal.data:::get_code_dependency(attr(datasets, "preprocessing_code"), names = datanames) + if (length(str_prepro) == 0) { + str_prepro <- "message('Preprocessing is empty')" + } else if (length(str_prepro) > 0) { + str_prepro <- paste0(str_prepro, "\n\n") } str_hash <- paste( @@ -80,5 +70,7 @@ get_datasets_code <- function(datanames, datasets, hashes) { "\n\n" ) - c(str_code, str_hash) + str_filter <- teal.slice::get_filter_expr(datasets, datanames) + + c(str_prepro, str_hash, str_filter) } diff --git a/R/init.R b/R/init.R index 8035815e7d..77e668019b 100644 --- a/R/init.R +++ b/R/init.R @@ -10,10 +10,6 @@ #' End-users: This is the most important function for you to start a #' teal app that is composed out of teal modules. #' -#' **Notes for developers**: -#' This is a wrapper function around the `module_teal.R` functions. Unless you are -#' an end-user, don't use this function, but instead this module. -#' #' @param data (`TealData` or `TealDataset` or `TealDatasetConnector` or `list` or `data.frame` #' or `MultiAssayExperiment`, `teal_data`, `teal_data_module`)\cr #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 0a35f7aaf5..73e8e1b2a8 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -311,8 +311,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi ) hashes <- calculate_hashes(datanames, datasets) - metadata <- lapply(datanames, datasets$get_metadata) - names(metadata) <- datanames + metadata <- sapply(datanames, datasets$get_metadata, simplify = FALSE) new_tdata( data, @@ -322,8 +321,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi c( get_rcode_str_install(), get_rcode_libraries(), - get_datasets_code(datanames, datasets, hashes), - teal.slice::get_filter_expr(datasets, datanames) + get_datasets_code(datanames, datasets, hashes) ) } ), diff --git a/R/module_teal.R b/R/module_teal.R index c1c4952271..cc4c08dcfe 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -173,6 +173,7 @@ srv_teal <- function(id, modules, teal_data_rv, filter = teal_slices()) { # create a list of data following structure of the nested modules list structure. # Because it's easier to unpack modules and datasets when they follow the same nested structure. datasets_singleton <- teal_data_to_filtered_data(teal_data_rv()) + # Singleton starts with only global filters active. filter_global <- Filter(function(x) x$id %in% attr(filter, "mapping")$global_filters, filter) datasets_singleton$set_filter_state(filter_global) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index e8a5ae92be..8d4afc59ae 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -76,7 +76,11 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { # teal_data_rv contains teal_data object # either passed to teal::init or returned from teal_data_module teal_data_rv <- if (inherits(data, "teal_data_module")) { - data$server(id = "teal_data_module") + data <- data$server(id = "teal_data_module") + if (!is.reactive(data)) { + stop("The `teal_data_module` must return a reactive expression.", call. = FALSE) + } + data } else if (inherits(data, "teal_data")) { reactiveVal(data) } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { @@ -109,10 +113,6 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data } - if (!is.reactive(teal_data_rv)) { - stop("The `teal_data_module` must return a reactive expression.", call. = FALSE) - } - teal_data_rv_validate <- reactive({ # custom module can return error data <- tryCatch(teal_data_rv(), error = function(e) e) @@ -141,7 +141,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { validate( need( FALSE, - paste0( + paste( "Error when executing `teal_data_module`:\n ", paste(data$message, collpase = "\n"), "\n Check your inputs or contact app developer if error persists." diff --git a/R/utils.R b/R/utils.R index 65647163fc..3a33619688 100644 --- a/R/utils.R +++ b/R/utils.R @@ -53,21 +53,21 @@ include_parent_datanames <- function(dataname, join_keys) { #' #' Create a `FilteredData` object from a `teal_data` object #' @param x (`teal_data`) object +#' @param datanames (`character`) vector of data set names to include; must be subset of `datanames(x)` #' @return (`FilteredData`) object #' @keywords internal teal_data_to_filtered_data <- function(x, datanames = teal.data::datanames(x)) { checkmate::assert_class(x, "teal_data") - checkmate::assert_character(datanames) + checkmate::assert_character(datanames, min.len = 1L, any.missing = FALSE) + checkmate::assert_subset(datanames, teal.data::datanames(x)) - teal.slice::init_filtered_data( - x = as.list(x@env)[datanames], - join_keys = join_keys(x)[datanames], - code = teal.data:::CodeClass$new( - code = paste(teal.code::get_code(x), collapse = "\n"), - dataname = teal.data::get_dataname(x) - ), - check = FALSE + ans <- teal.slice::init_filtered_data( + x = sapply(datanames, function(dn) x[[dn]], simplify = FALSE), + join_keys = teal.data::join_keys(x) ) + # Piggy-back entire pre-processing code so that filtering code can be appended later. + attr(ans, "preprocessing_code") <- teal.code::get_code(x) + ans } #' Template Function for `TealReportCard` Creation and Customization diff --git a/man/get_datasets_code.Rd b/man/get_datasets_code.Rd index ad0457094c..f7256b8340 100644 --- a/man/get_datasets_code.Rd +++ b/man/get_datasets_code.Rd @@ -14,10 +14,11 @@ get_datasets_code(datanames, datasets, hashes) \item{hashes}{named (\code{list}) of hashes per dataset} } \value{ -\code{character(3)} containing following elements: +\code{character(3)} containing the following elements: \itemize{ -\item code from \code{CodeClass} (data loading code) +\item data pre-processing code (from \code{data} argument in \code{init}) \item hash check of loaded objects +\item filter code } } \description{ diff --git a/man/init.Rd b/man/init.Rd index f03437f1b3..0e7ef57199 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -61,10 +61,6 @@ named list with \code{server} and \code{ui} function \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} End-users: This is the most important function for you to start a teal app that is composed out of teal modules. - -\strong{Notes for developers}: -This is a wrapper function around the \code{module_teal.R} functions. Unless you are -an end-user, don't use this function, but instead this module. } \examples{ new_iris <- transform(iris, id = seq_len(nrow(iris))) diff --git a/man/teal_data_to_filtered_data.Rd b/man/teal_data_to_filtered_data.Rd index 440abd4504..2528930eb5 100644 --- a/man/teal_data_to_filtered_data.Rd +++ b/man/teal_data_to_filtered_data.Rd @@ -8,6 +8,8 @@ teal_data_to_filtered_data(x, datanames = teal.data::datanames(x)) } \arguments{ \item{x}{(\code{teal_data}) object} + +\item{datanames}{(\code{character}) vector of data set names to include; must be subset of \code{datanames(x)}} } \value{ (\code{FilteredData}) object diff --git a/tests/testthat/test-module_nested_tabs.R b/tests/testthat/test-module_nested_tabs.R index 87b2b78ea4..db0890ceb7 100644 --- a/tests/testthat/test-module_nested_tabs.R +++ b/tests/testthat/test-module_nested_tabs.R @@ -1,6 +1,8 @@ -filtered_data <- teal.slice::init_filtered_data( - list(iris = list(dataset = head(iris))) -) +teal_data <- teal.data::teal_data() +teal_data <- within(teal_data, iris <- head(iris)) +teal_data <- teal.data::teal_data() |> within(iris <- head(iris)) +datanames(teal_data) <- "iris" +filtered_data <- teal_data_to_filtered_data(teal_data) test_module1 <- module( label = "test1", @@ -36,22 +38,12 @@ test_module_wdata <- function(datanames) { } get_example_filtered_data <- function() { - d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5) - d2 <- data.frame(id = 1:5, value = 1:5) - - cc <- teal.data:::CodeClass$new() - cc$set_code("d1 <- data.frame(id = 1:5, pk = c(2,3,2,1,4), val = 1:5)", "d1") - cc$set_code("d2 <- data.frame(id = 1:5, value = 1:5)", "d2") - - teal.slice::init_filtered_data( - x = list( - d1 = list(dataset = d1, metadata = list("A" = 1)), - d2 = list(dataset = d2) - ), - join_keys = teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id"))), - code = cc, - check = TRUE - ) + td <- teal.data::teal_data() + td <- within(td, d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)) + td <- within(td, d2 <- data.frame(id = 1:5, value = 1:5)) + datanames(td) <- c("d1", "d2") + teal.data::join_keys(td) <- teal.data::join_keys(teal.data::join_key("d1", "d2", c("pk" = "id"))) + teal_data_to_filtered_data(td) } @@ -461,7 +453,8 @@ testthat::test_that(".datasets_to_data returns tdata object", { c( get_rcode_str_install(), get_rcode_libraries(), - "d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)\nd2 <- data.frame(id = 1:5, value = 1:5)\n\n", + "d1 <- data.frame(id = 1:5, pk = c(2, 3, 2, 1, 4), val = 1:5)\n\n", + "d2 <- data.frame(id = 1:5, value = 1:5)\n\n", paste0( "stopifnot(rlang::hash(d1) == \"f6f90d2c133ca4abdeb2f7a7d85b731e\")\n", "stopifnot(rlang::hash(d2) == \"6e30be195b7d914a1311672c3ebf4e4f\") \n\n" @@ -469,14 +462,6 @@ testthat::test_that(".datasets_to_data returns tdata object", { "" ) ) - - # metadata - testthat::expect_equal( - get_metadata(data, "d1"), - list(A = 1) - ) - - testthat::expect_null(get_metadata(data, "d2")) }) testthat::test_that("calculate_hashes takes a FilteredData and vector of datanames as input", { diff --git a/tests/testthat/test-module_tabs_with_filters.R b/tests/testthat/test-module_tabs_with_filters.R index a82042cc81..1c9d1f8385 100644 --- a/tests/testthat/test-module_tabs_with_filters.R +++ b/tests/testthat/test-module_tabs_with_filters.R @@ -1,9 +1,8 @@ -filtered_data <- teal.slice::init_filtered_data( - list( - iris = list(dataset = head(iris)), - mtcars = list(dataset = head(mtcars)) - ) -) +teal_data <- teal.data::teal_data() +teal_data <- within(teal_data, iris <- head(iris)) +teal_data <- within(teal_data, mtcars <- head(mtcars)) +datanames(teal_data) <- c("iris", "mtcars") +filtered_data <- teal_data_to_filtered_data(teal_data) test_module1 <- module( label = "iris tab", diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index 577e997582..a68f047f02 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -96,7 +96,7 @@ testthat::test_that("srv_teal_with_splash teal_data_rv_validate throws then qenv id = "test", data = teal_data_module( ui = function(id) div(), - server = function(id) reactive(teal_data() |> within(stop("not good"))) + server = function(id) reactive(teal_data() %>% within(stop("not good"))) ), modules = modules(example_module()) ),