From 5c17ccfd780fe7e22a62212fee77fbeec4e00620 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 4 Oct 2023 13:51:20 +0200 Subject: [PATCH 01/22] following new teal_data class --- R/init.R | 24 ++++++++++++++++++++---- R/module_nested_tabs.R | 14 ++++++++------ R/module_teal.R | 27 ++++----------------------- R/module_teal_with_splash.R | 18 ++++++++++-------- 4 files changed, 42 insertions(+), 41 deletions(-) diff --git a/R/init.R b/R/init.R index 4fdb147951..d76a9ef750 100644 --- a/R/init.R +++ b/R/init.R @@ -116,7 +116,10 @@ init <- function(data, logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") data <- teal.data::to_relational_data(data = data) - checkmate::assert_class(data, "TealData") + if (!inherits(data, c("TealData", "teal_data"))) { + data <- teal.data::to_relational_data(data = data) + } + checkmate::assert_multi_class(data, c("TealData", "teal_data")) checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules")) checkmate::assert_string(title, null.ok = TRUE) checkmate::assert( @@ -138,7 +141,7 @@ init <- function(data, # resolve modules datanames datanames <- teal.data::get_dataname(data) - join_keys <- data$get_join_keys() + join_keys <- teal.data::get_join_keys(data) resolve_modules_datanames <- function(modules) { if (inherits(modules, "teal_modules")) { modules$children <- sapply(modules$children, resolve_modules_datanames, simplify = FALSE) @@ -147,6 +150,17 @@ init <- function(data, modules$datanames <- if (identical(modules$datanames, "all")) { datanames } else if (is.character(modules$datanames)) { + extra_datanames <- setdiff(modules$datanames, datanames) + if (length(extra_datanames)) { + stop( + sprintf( + "Module %s has datanames that are not available in a 'data':\n %s not in %s", + modules$label, + toString(extra_datanames), + toString(datanames) + ) + ) + } datanames_adjusted <- intersect(modules$datanames, datanames) include_parent_datanames(dataname = datanames_adjusted, join_keys = join_keys) } @@ -212,8 +226,10 @@ init <- function(data, res <- list( ui = ui_teal_with_splash(id = id, data = data, title = title, header = header, footer = footer), server = function(input, output, session) { - # copy object so that load won't be shared between the session - data <- data$copy(deep = TRUE) + if (inherits(data, "TealDataAbstract")) { + # copy TealData so that load won't be shared between the session + data <- data$copy(deep = TRUE) + } filter <- deep_copy_filter(filter) srv_teal_with_splash(id = id, data = data, modules = modules, filter = filter) } diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 443587b07e..0a012f32dd 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -314,12 +314,14 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi data, eventReactive( trigger_data(), - c( - get_rcode_str_install(), - get_rcode_libraries(), - get_datasets_code(datanames, datasets, hashes), - teal.slice::get_filter_expr(datasets, datanames) - ) + { + c( + get_rcode_str_install(), + get_rcode_libraries(), + get_datasets_code(datanames, datasets, hashes), + teal.slice::get_filter_expr(datasets, datanames) + ) + } ), datasets$get_join_keys(), metadata diff --git a/R/module_teal.R b/R/module_teal.R index fbce6ed5bd..d61dc42a67 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -162,10 +162,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # loading the data ----- env <- environment() - datasets_reactive <- reactive({ - if (is.null(raw_data())) { - return(NULL) - } + datasets_reactive <- eventReactive(raw_data(), ignoreNULL = TRUE, { env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") @@ -184,25 +181,9 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { } else if (isTRUE(attr(filter, "module_specific"))) { # we should create FilteredData even if modules$datanames is null # null controls a display of filter panel but data should be still passed - datanames <- if (is.null(modules$datanames)) raw_data()$get_datanames() else modules$datanames - data_objects <- sapply( - datanames, - function(dataname) { - dataset <- raw_data()$get_dataset(dataname) - list( - dataset = dataset$get_raw_data(), - metadata = dataset$get_metadata(), - label = dataset$get_dataset_label() - ) - }, - simplify = FALSE - ) - datasets_module <- teal.slice::init_filtered_data( - data_objects, - join_keys = raw_data()$get_join_keys(), - code = raw_data()$get_code_class(), - check = raw_data()$get_check() - ) + datanames <- if (is.null(modules$datanames)) teal.data::get_dataname(raw_data()) else modules$datanames + # todo: subset tdata object to datanames + datasets_module <- teal.slice::init_filtered_data(raw_data()) # set initial filters slices <- Filter(x = filter, f = function(x) { diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 2a4b19e3e9..910c346fcb 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -22,16 +22,16 @@ ui_teal_with_splash <- function(id, title, header = tags$p("Add Title Here"), footer = tags$p("Add Footer Here")) { - checkmate::assert_class(data, "TealDataAbstract") - is_pulled_data <- teal.data::is_pulled(data) + checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data")) ns <- NS(id) # Startup splash screen for delayed loading # We use delayed loading in all cases, even when the data does not need to be fetched. # This has the benefit that when filtering the data takes a lot of time initially, the # Shiny app does not time out. - splash_ui <- if (is_pulled_data) { - # blank ui if data is already pulled + splash_ui <- if (inherits(data, "teal_data")) { + div() + } else if (teal.data::is_pulled(data)) { div() } else { message("App was initialized with delayed data loading.") @@ -55,7 +55,7 @@ ui_teal_with_splash <- function(id, #' @return `reactive`, return value of [srv_teal()] #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { - checkmate::assert_class(data, "TealDataAbstract") + checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data")) moduleServer(id, function(input, output, session) { logger::log_trace( "srv_teal_with_splash initializing module with data { paste(data$get_datanames(), collapse = ' ')}." @@ -65,17 +65,19 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { shinyjs::showLog() } - is_pulled_data <- teal.data::is_pulled(data) # raw_data contains TealDataAbstract, i.e. R6 object and container for data # reactive to get data through delayed loading # we must leave it inside the server because of callModule which needs to pick up the right session - if (is_pulled_data) { - raw_data <- reactiveVal(data) # will trigger by setting it + raw_data <- if (inherits(data, "teal_data")) { + reactiveVal(data) + } else if (teal.data::is_pulled(data)) { + reactiveVal(data) # will trigger by setting it } else { raw_data <- data$get_server()(id = "startapp_module") if (!is.reactive(raw_data)) { stop("The delayed loading module has to return a reactive object.") } + raw_data } res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data, filter = filter) From 4051dedb92639f06dfb3ce7e8479fd44324caf70 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 5 Oct 2023 15:49:33 +0200 Subject: [PATCH 02/22] reverting breaking changes and supporting teal_data --- R/init.R | 1 - R/module_teal_with_splash.R | 18 ++++++++++++++++-- 2 files changed, 16 insertions(+), 3 deletions(-) diff --git a/R/init.R b/R/init.R index d76a9ef750..ee7ec5ebfe 100644 --- a/R/init.R +++ b/R/init.R @@ -114,7 +114,6 @@ init <- function(data, footer = tags$p(), id = character(0)) { logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).") - data <- teal.data::to_relational_data(data = data) if (!inherits(data, c("TealData", "teal_data"))) { data <- teal.data::to_relational_data(data = data) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 910c346fcb..dc91b88a51 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -71,9 +71,23 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data <- if (inherits(data, "teal_data")) { reactiveVal(data) } else if (teal.data::is_pulled(data)) { - reactiveVal(data) # will trigger by setting it + new_data <- new_teal_data( + env = lapply(data$get_datasets(), function(x) x$get_raw_data()), + code = data$get_code(), + keys = data$get_join_keys() + ) + reactiveVal(new_data) # will trigger by setting it } else { - raw_data <- data$get_server()(id = "startapp_module") + raw_data_old <- data$get_server()(id = "startapp_module") + raw_data <- reactive({ + data <- raw_data_old() + new_teal_data( + env = lapply(data$get_datasets(), function(x) x$get_raw_data()), + code = data$get_code(), + keys = data$get_join_keys() + ) + }) + if (!is.reactive(raw_data)) { stop("The delayed loading module has to return a reactive object.") } From c3eab5aa80acce33603233e1a57ef190bec7b9ba Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 6 Oct 2023 08:22:50 +0200 Subject: [PATCH 03/22] filtered data constructor in teal internals --- R/dummy_functions.R | 11 +++-------- R/module_teal.R | 5 ++--- R/utils.R | 23 +++++++++++++++++++++++ 3 files changed, 28 insertions(+), 11 deletions(-) diff --git a/R/dummy_functions.R b/R/dummy_functions.R index cf0c0116d4..1fdaea0d8e 100644 --- a/R/dummy_functions.R +++ b/R/dummy_functions.R @@ -23,14 +23,9 @@ example_cdisc_data <- function() { # nolint ADSL$logical_test <- sample(c(TRUE, FALSE, NA), size = nrow(ADSL), replace = TRUE) # nolint ADSL$SEX[c(2, 5)] <- NA # nolint - cdisc_data_obj <- teal.data::cdisc_data( - cdisc_dataset(dataname = "ADSL", x = ADSL), - cdisc_dataset(dataname = "ADTTE", x = ADTTE) - ) - res <- teal.data::cdisc_data( - teal.data::cdisc_dataset(dataname = "ADSL", x = ADSL), - teal.data::cdisc_dataset(dataname = "ADTTE", x = ADTTE), + ADSL = ADSL, + ADTTE = ADTTE, code = ' ADSL <- data.frame( STUDYID = "study", @@ -62,7 +57,7 @@ example_cdisc_data <- function() { # nolint #' @keywords internal example_datasets <- function() { # nolint dummy_cdisc_data <- example_cdisc_data() - datasets <- teal.slice::init_filtered_data(dummy_cdisc_data) + datasets <- teal_data_to_filtered_data(dummy_cdisc_data) list( "d2" = list( "d3" = list( diff --git a/R/module_teal.R b/R/module_teal.R index d61dc42a67..5c5f9de1e1 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -160,7 +160,6 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { } ) - # loading the data ----- env <- environment() datasets_reactive <- eventReactive(raw_data(), ignoreNULL = TRUE, { env$progress <- shiny::Progress$new(session) @@ -168,7 +167,7 @@ srv_teal <- function(id, modules, raw_data, 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.slice::init_filtered_data(raw_data()) + datasets_singleton <- teal_data_to_filtered_data(raw_data()) # 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) @@ -183,7 +182,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # null controls a display of filter panel but data should be still passed datanames <- if (is.null(modules$datanames)) teal.data::get_dataname(raw_data()) else modules$datanames # todo: subset tdata object to datanames - datasets_module <- teal.slice::init_filtered_data(raw_data()) + datasets_module <- teal_data_to_filtered_data(raw_data()) # set initial filters slices <- Filter(x = filter, f = function(x) { diff --git a/R/utils.R b/R/utils.R index 9d284e5054..d73dc67258 100644 --- a/R/utils.R +++ b/R/utils.R @@ -46,3 +46,26 @@ include_parent_datanames <- function(dataname, join_keys) { return(unique(c(parents, dataname))) } + + + +#' Create a `FilteredData` +#' +#' Create a `FilteredData` object from a `teal_data` object +#' @param x (`teal_data`) object +#' @return (`FilteredData`) object +#' @keywords internal +teal_data_to_filtered_data <- function(x) { # nolint + checkmate::assert_class(x, "teal_data") + datanames <- x@datanames + + teal.slice::init_filtered_data( + x = as.list(x@env)[datanames], + join_keys = x@join_keys, + code = teal.data:::CodeClass$new( + code = paste(teal.code::get_code(x), collapse = "\n"), + dataname = teal.data::get_dataname(x) + ), + check = FALSE + ) +} From 8164671d376701cd51801d5b9867b0a24633d17c Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 6 Oct 2023 15:51:52 +0200 Subject: [PATCH 04/22] new_teal_data env to data --- R/module_teal_with_splash.R | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index dc91b88a51..07e279adc6 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -72,7 +72,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { reactiveVal(data) } else if (teal.data::is_pulled(data)) { new_data <- new_teal_data( - env = lapply(data$get_datasets(), function(x) x$get_raw_data()), + data = lapply(data$get_datasets(), function(x) x$get_raw_data()), code = data$get_code(), keys = data$get_join_keys() ) @@ -82,7 +82,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data <- reactive({ data <- raw_data_old() new_teal_data( - env = lapply(data$get_datasets(), function(x) x$get_raw_data()), + data = lapply(data$get_datasets(), function(x) x$get_raw_data()), code = data$get_code(), keys = data$get_join_keys() ) From 354a79d825d12964647bda4b782175d96e53f29c Mon Sep 17 00:00:00 2001 From: "27856297+dependabot-preview[bot]@users.noreply.github.com" <27856297+dependabot-preview[bot]@users.noreply.github.com> Date: Fri, 6 Oct 2023 13:58:09 +0000 Subject: [PATCH 05/22] [skip actions] Roxygen Man Pages Auto Update --- man/teal_data_to_filtered_data.Rd | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) create mode 100644 man/teal_data_to_filtered_data.Rd diff --git a/man/teal_data_to_filtered_data.Rd b/man/teal_data_to_filtered_data.Rd new file mode 100644 index 0000000000..7ab5828072 --- /dev/null +++ b/man/teal_data_to_filtered_data.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{teal_data_to_filtered_data} +\alias{teal_data_to_filtered_data} +\title{Create a \code{FilteredData}} +\usage{ +teal_data_to_filtered_data(x) +} +\arguments{ +\item{x}{(\code{teal_data}) object} +} +\value{ +(\code{FilteredData}) object +} +\description{ +Create a \code{FilteredData} object from a \code{teal_data} object +} +\keyword{internal} From 34bad8c8f31f523778dac9a67c38e12c4971bf5d Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 19 Oct 2023 11:44:40 +0200 Subject: [PATCH 06/22] fix tests --- R/init.R | 2 +- R/module_teal.R | 2 +- R/module_teal_with_splash.R | 17 +- man/init.Rd | 2 +- man/module_teal.Rd | 2 +- man/srv_teal_with_splash.Rd | 5 +- man/ui_teal_with_splash.Rd | 2 +- tests/testthat/test-init.R | 167 ++++++++++-------- tests/testthat/test-module_teal.R | 13 +- tests/testthat/test-module_teal_with_splash.R | 10 +- 10 files changed, 119 insertions(+), 103 deletions(-) diff --git a/R/init.R b/R/init.R index ee7ec5ebfe..13431f175b 100644 --- a/R/init.R +++ b/R/init.R @@ -15,7 +15,7 @@ #' 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`)\cr +#' or `MultiAssayExperiment`, `teal_data`)\cr #' `R6` object as returned by [teal.data::cdisc_data()], [teal.data::teal_data()], #' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or #' [teal.data::cdisc_dataset_connector()] or a single `data.frame` or a `MultiAssayExperiment` diff --git a/R/module_teal.R b/R/module_teal.R index 5c5f9de1e1..766915ab70 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -34,7 +34,7 @@ #' [init()] about how to call the corresponding server function. #' #' @param raw_data (`reactive`)\cr -#' returns the `TealData`, only evaluated once, `NULL` value is ignored +#' returns the `teal_data`, only evaluated once, `NULL` value is ignored #' #' @return #' `ui_teal` returns `HTML` for Shiny module UI. diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 07e279adc6..afe21fc317 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -52,7 +52,8 @@ ui_teal_with_splash <- function(id, #' will be displayed in the teal application. See [modules()] and [module()] for #' more details. #' @inheritParams shiny::moduleServer -#' @return `reactive`, return value of [srv_teal()] +#' @return `reactive` containing `teal_data` object when data is loaded. +#' If data is not loaded yet, `reactive` returns `NULL`. #' @export srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data")) @@ -81,11 +82,15 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data_old <- data$get_server()(id = "startapp_module") raw_data <- reactive({ data <- raw_data_old() - new_teal_data( - data = lapply(data$get_datasets(), function(x) x$get_raw_data()), - code = data$get_code(), - keys = data$get_join_keys() - ) + if (!is.null(data)) { + # raw_data is a reactive which returns data only when submit button clicked + # otherwise it returns NULL + new_teal_data( + data = lapply(data$get_datasets(), function(x) x$get_raw_data()), + code = data$get_code(), + keys = data$get_join_keys() + ) + } }) if (!is.reactive(raw_data)) { diff --git a/man/init.Rd b/man/init.Rd index 234f60697f..07bbec2deb 100644 --- a/man/init.Rd +++ b/man/init.Rd @@ -16,7 +16,7 @@ init( } \arguments{ \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} -or \code{MultiAssayExperiment})\cr +or \code{MultiAssayExperiment}, \code{teal_data})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, \code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or \code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} diff --git a/man/module_teal.Rd b/man/module_teal.Rd index a9a7f7f0ea..10c1c8654c 100644 --- a/man/module_teal.Rd +++ b/man/module_teal.Rd @@ -36,7 +36,7 @@ argument) will be placed in the app's \code{ui} function so code which needs to the footer of the app} \item{raw_data}{(\code{reactive})\cr -returns the \code{TealData}, only evaluated once, \code{NULL} value is ignored} +returns the \code{teal_data}, only evaluated once, \code{NULL} value is ignored} } \value{ \code{ui_teal} returns \code{HTML} for Shiny module UI. diff --git a/man/srv_teal_with_splash.Rd b/man/srv_teal_with_splash.Rd index abee79b6d1..7ab0c6efea 100644 --- a/man/srv_teal_with_splash.Rd +++ b/man/srv_teal_with_splash.Rd @@ -15,7 +15,7 @@ See the vignette for an example. However, \code{\link[=ui_teal_with_splash]{ui_t is then preferred to this function.} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} -or \code{MultiAssayExperiment})\cr +or \code{MultiAssayExperiment}, \code{teal_data})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, \code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or \code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} @@ -34,7 +34,8 @@ Old way of specifying filters through a list is deprecated and will be removed i next release. Please fix your applications to use \code{\link[=teal_slices]{teal_slices()}}.} } \value{ -\code{reactive}, return value of \code{\link[=srv_teal]{srv_teal()}} +\code{reactive} containing \code{teal_data} object when data is loaded. +If data is not loaded yet, \code{reactive} returns \code{NULL}. } \description{ \ifelse{html}{\href{https://lifecycle.r-lib.org/articles/stages.html#stable}{\figure{lifecycle-stable.svg}{options: alt='[Stable]'}}}{\strong{[Stable]}} diff --git a/man/ui_teal_with_splash.Rd b/man/ui_teal_with_splash.Rd index 7536afe2a7..0ece4d3027 100644 --- a/man/ui_teal_with_splash.Rd +++ b/man/ui_teal_with_splash.Rd @@ -17,7 +17,7 @@ ui_teal_with_splash( module id} \item{data}{(\code{TealData} or \code{TealDataset} or \code{TealDatasetConnector} or \code{list} or \code{data.frame} -or \code{MultiAssayExperiment})\cr +or \code{MultiAssayExperiment}, \code{teal_data})\cr \code{R6} object as returned by \code{\link[teal.data:cdisc_data]{teal.data::cdisc_data()}}, \code{\link[teal.data:teal_data]{teal.data::teal_data()}}, \code{\link[teal.data:cdisc_dataset]{teal.data::cdisc_dataset()}}, \code{\link[teal.data:dataset]{teal.data::dataset()}}, \code{\link[teal.data:dataset_connector]{teal.data::dataset_connector()}} or \code{\link[teal.data:cdisc_dataset_connector]{teal.data::cdisc_dataset_connector()}} or a single \code{data.frame} or a \code{MultiAssayExperiment} diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 834da959d0..6a567480cb 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -1,133 +1,143 @@ -dataset_1 <- teal.data::dataset("iris", head(iris)) -adsl_df <- as.data.frame(as.list(setNames(nm = teal.data::get_cdisc_keys("ADSL")))) -adsl_dataset <- teal.data::cdisc_dataset( - "ADSL", adsl_df, - parent = character(0), keys = teal.data::get_cdisc_keys("ADSL") -) -mods <- teal:::example_modules() - -testthat::test_that("init data accepts TealData objects", { - teal_data_object <- teal.data::teal_data(dataset_1) - cdisc_data_object <- teal.data::cdisc_data(adsl_dataset) - testthat::expect_error(init(data = teal_data_object, modules = mods), NA) - testthat::expect_error(init(data = cdisc_data_object, modules = mods), NA) -}) - -testthat::test_that("init data throws an error with input other than accepted input", { +testthat::test_that("init data accepts TealData object", { + testthat::expect_no_error( + init( + data = teal.data::cdisc_data( + teal.data::cdisc_dataset( + "ADSL", + as.data.frame(as.list(setNames(nm = teal.data::get_cdisc_keys("ADSL")))), + parent = character(0), + keys = teal.data::get_cdisc_keys("ADSL") + ) + ), + modules = teal:::example_modules(datanames = "ADSL") + ) + ) +}) + +testthat::test_that("init data accepts teal_data object", { + testthat::expect_no_error( + init( + data = teal.data::teal_data(iris = iris), + modules = modules(teal:::example_module()) + ) + ) +}) + +testthat::test_that("init data throws an error with input other than TealData, teal_data and ddl", { character_vector <- c("a", "b", "c") numeric_vector <- c(1, 2, 3) matrix_d <- as.matrix(c(1, 2, 3)) - teal_data_list <- list(teal.data::teal_data(dataset_1)) - mods <- teal:::example_modules() - testthat::expect_error(init(data = character_vector, modules = mods)) - testthat::expect_error(init(data = numeric_vector, modules = mods)) - testthat::expect_error(init(data = numeric_vector, modules = mods)) - testthat::expect_error(init(data = matrix_d, modules = mods)) - testthat::expect_error(init(data = teal_data_list, modules = mods)) + teal_data_list <- list(teal.data::teal_data(teal.data::dataset("iris", iris))) + testthat::expect_error(init(data = character_vector, modules = modules(example_module()))) + testthat::expect_error(init(data = numeric_vector, modules = modules(example_module()))) + testthat::expect_error(init(data = numeric_vector, modules = modules(example_module()))) + testthat::expect_error(init(data = matrix_d, modules = modules(example_module()))) + testthat::expect_error(init(data = teal_data_list, modules = modules(example_module()))) }) -testthat::test_that("init data accepts a single TealDataset/CDISCTealDataset", { - testthat::expect_error(init(data = teal.data::dataset("iris", head(iris)), modules = mods), NA) - testthat::expect_error( +testthat::test_that("init data accepts a single TealDataset", { + testthat::expect_no_error( init( - data = teal.data::cdisc_dataset("ADSL", adsl_df, parent = character(0), keys = teal.data::get_cdisc_keys("ADSL")), - modules = mods - ), - NA + data = teal.data::dataset("ADSL", head(iris)), + modules = teal:::example_modules(datanames = "ADSL") + ) ) - testthat::expect_error(init(data = dataset_1, modules = mods), NA) - testthat::expect_error(init(data = adsl_dataset, modules = mods), NA) }) -testthat::test_that("init data accepts a list of single TealDataset/CDISCTealDataset without renaming", { - dataset_list <- list(teal.data::dataset("iris", head(iris))) - cdisc_dataset_list <- list( - teal.data::cdisc_dataset("ADSL", adsl_df, parent = character(0), keys = teal.data::get_cdisc_keys("ADSL")) +testthat::test_that("init data accepts a list of single TealDataset without renaming", { + testthat::expect_no_error( + init( + data = list( + teal.data::dataset("ADSL", head(iris)), + teal.data::dataset("ADTTE", head(iris)) + ), + modules = teal:::example_modules() + ) ) - - testthat::expect_error(init(data = list(teal.data::dataset("iris", head(iris))), modules = mods), NA) - testthat::expect_error(init( - data = list( - teal.data::cdisc_dataset("ADSL", adsl_df, parent = character(0), keys = teal.data::get_cdisc_keys("ADSL")) - ), - modules = mods - ), NA) - testthat::expect_error(init(data = dataset_list, modules = mods), NA) - testthat::expect_error(init(data = cdisc_dataset_list, modules = mods), NA) }) testthat::test_that("init data accepts a single dataframe", { - testthat::expect_error(init(data = adsl_df, modules = mods), NA) + testthat::expect_no_error( + init(data = list(iris = iris), modules = modules(example_module())) + ) }) testthat::test_that("init data accepts a list of single dataframe without renaming", { - testthat::expect_error(init(data = list(adsl_df), modules = mods), NA) + testthat::expect_no_error( + init(data = list(iris, mtcars), modules = modules(example_module())) + ) }) testthat::test_that("init data accepts a list of single dataframe with renaming", { - adsl_list <- list(data1 = adsl_df) - testthat::expect_error(init(data = list(data1 = adsl_df), modules = mods), NA) - testthat::expect_error(init(data = adsl_list, modules = mods), NA) + testthat::expect_no_error( + init( + data = list(iris2 = iris), + modules = modules(example_module()) + ) + ) }) testthat::test_that("init data accepts a list of a TealDataset and a dataframe without renaming", { - testthat::expect_error(init(data = list(dataset_1, adsl_df), modules = mods), NA) + testthat::expect_no_error( + init( + data = list(teal.data::dataset("ADSL", head(iris)), iris), + modules = modules(example_module()) + ) + ) }) testthat::test_that("init data accepts a single MultiAssayExperiment object", { utils::data(miniACC, package = "MultiAssayExperiment") - testthat::expect_error(init(data = miniACC, modules = mods), NA) + testthat::expect_no_error( + init(data = list(MAE = miniACC), modules = modules(example_module())) + ) }) testthat::test_that("init data accepts a list of a single MultiAssayExperiment object without renaming", { utils::data(miniACC, package = "MultiAssayExperiment") - testthat::expect_error(init(data = list(miniACC), modules = mods), NA) + testthat::expect_no_error(init(data = list(miniACC), modules = modules(example_module()))) }) testthat::test_that("init data accepts a list of a single MultiAssayExperiment object with renaming", { utils::data(miniACC, package = "MultiAssayExperiment") - testthat::expect_error(init(data = list(x = miniACC), modules = mods), NA) + testthat::expect_no_error(init(data = list(x = miniACC), modules = modules(example_module()))) }) testthat::test_that("init data acceptsa mixed list of MultiAssayExperiment object and data.frame", { utils::data(miniACC, package = "MultiAssayExperiment") - testthat::expect_error(init(data = list(x = miniACC, y = head(iris)), modules = mods), NA) + testthat::expect_no_error(init(data = list(x = miniACC, y = head(iris)), modules = modules(example_module()))) }) testthat::test_that("init data accepts a list of a TealDataset and a dataframe with renaming", { - testthat::expect_error(init( + testthat::expect_no_error(init( data = list( data1 = teal.data::dataset("iris", head(iris)), data2 = as.data.frame(as.list(setNames(nm = teal.data::get_cdisc_keys("ADSL")))) ), - modules = mods - ), NA) - testthat::expect_error(init(data = list(data1 = dataset_1, data2 = adsl_df), modules = mods), NA) + modules = modules(example_module()) + )) }) testthat::test_that("init data accepts a list of mixed TealDataset and dataframe with mixed renaming", { - testthat::expect_error(init(data = list(data1 = teal.data::dataset("iris", head(iris)), adsl_df), modules = mods), NA) - testthat::expect_error(init(data = list(dataset_1, data2 = adsl_df), modules = mods), NA) + testthat::expect_no_error( + init( + data = list( + data1 = teal.data::dataset("iris", head(iris)), + iris2 = iris + ), + modules = modules(example_module()) + ) + ) }) testthat::test_that("init data accepts TealDatasetConnector object", { dsc1 <- teal.data::dataset_connector("iris", teal.data::callable_function(function() head(iris))) - testthat::expect_error(init(data = dsc1, modules = mods), NA) - testthat::expect_error(init( - data = teal.data::dataset_connector("iris", teal.data::callable_function(function() head(iris))), - modules = mods - ), NA) + testthat::expect_no_error(init(data = dsc1, modules = modules(example_module()))) }) testthat::test_that("init data accepts a list of TealDatasetConnector object", { dsc1 <- list(teal.data::dataset_connector("iris", teal.data::callable_function(function() head(iris)))) - testthat::expect_error(init(data = dsc1, modules = mods), NA) - testthat::expect_error( - init(data = list( - teal.data::dataset_connector("iris", teal.data::callable_function(function() head(iris))) - ), modules = mods), - NA - ) + testthat::expect_no_error(init(data = dsc1, modules = modules(example_module()))) }) testthat::test_that("init modules accepts a teal_modules object", { @@ -154,7 +164,10 @@ testthat::test_that("init filter accepts named list or `teal_slices`", { fs <- teal.slice::teal_slices( teal.slice::teal_slice(dataname = "iris", varname = "species", selected = "setosa") ) - testthat::expect_no_error(init(data = dataset_1, modules = mods, filter = fl)) - testthat::expect_no_error(init(data = dataset_1, modules = mods, filter = fs)) - testthat::expect_error(init(data = dataset_1, modules = mods, filter = unclass(fs)), "Assertion failed") + testthat::expect_no_error(init(data = list(iris), modules = modules(example_module()), filter = fl)) + testthat::expect_no_error(init(data = list(iris), modules = modules(example_module()), filter = fs)) + testthat::expect_error( + init(data = list(iris), modules = modules(example_module()), filter = unclass(fs)), + "Assertion failed" + ) }) diff --git a/tests/testthat/test-module_teal.R b/tests/testthat/test-module_teal.R index fddc04b2c7..ca3cc28d8f 100644 --- a/tests/testthat/test-module_teal.R +++ b/tests/testthat/test-module_teal.R @@ -1,14 +1,12 @@ -iris_ds <- teal.data::dataset(dataname = "iris", x = iris) -mtcars_ds <- teal.data::dataset(dataname = "mtcars", x = mtcars) -data <- teal_data(iris_ds, mtcars_ds) +data <- teal_data(iris1 = iris, mtcars1 = mtcars, code = "iris1 <- iris; mtcars1 <- mtcars") -test_module1 <- module( +test_module1 <- example_module( label = "iris_tab", - datanames = "iris" + datanames = "iris1" ) -test_module2 <- module( +test_module2 <- example_module( label = "mtcars_tab", - datanames = "mtcars" + datanames = "mtcars1" ) testthat::test_that("srv_teal fails when raw_data is not reactive", { @@ -35,7 +33,6 @@ testthat::test_that("srv_teal initializes the data when raw_data changes", { modules = modules(test_module1) ), expr = { - testthat::expect_null(datasets_reactive()) raw_data(data) testthat::expect_named(datasets_reactive(), "iris_tab") } diff --git a/tests/testthat/test-module_teal_with_splash.R b/tests/testthat/test-module_teal_with_splash.R index f96d13633a..039ea01011 100644 --- a/tests/testthat/test-module_teal_with_splash.R +++ b/tests/testthat/test-module_teal_with_splash.R @@ -2,12 +2,12 @@ iris_ds <- teal.data::dataset(dataname = "iris", x = head(iris)) mtcars_ds <- teal.data::dataset(dataname = "mtcars", x = head(mtcars)) data <- teal_data(iris_ds, mtcars_ds) -test_module1 <- module( +test_module1 <- example_module( label = "iris_tab", datanames = "iris" ) -testthat::test_that("srv_teal_with_splash creates reactiveVal returning data input", { +testthat::test_that("srv_teal_with_splash creates reactiveVal returning teal_data", { shiny::testServer( app = srv_teal_with_splash, args = list( @@ -17,7 +17,7 @@ testthat::test_that("srv_teal_with_splash creates reactiveVal returning data inp ), expr = { testthat::expect_is(raw_data, "reactiveVal") - testthat::expect_identical(raw_data(), data) + testthat::expect_s4_class(raw_data(), "teal_data") } ) }) @@ -50,8 +50,8 @@ testthat::test_that("srv_teal_with_splash creates raw_data based on DDL returns expr = { testthat::expect_null(raw_data()) session$setInputs(`startapp_module-submit` = TRUE) # DDL has independent session id (without ns) - testthat::expect_is(raw_data(), "TealData") - testthat::expect_identical(raw_data()$get_dataset("iris")$get_raw_data(), iris) + testthat::expect_is(raw_data(), "teal_data") + testthat::expect_identical(raw_data()[["iris"]], iris) } ) }) From fc830841f95a662220995a07fbbdf96edc9851a2 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 23 Oct 2023 11:14:41 +0200 Subject: [PATCH 07/22] fix 1 after merge --- R/init.R | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/R/init.R b/R/init.R index 34b8c1b36b..f36e464c93 100644 --- a/R/init.R +++ b/R/init.R @@ -179,13 +179,18 @@ init <- function(data, # Calculate app hash to ensure snapshot compatibility. See ?snapshot. Raw data must be extracted from environments. hashables <- mget(c("data", "modules")) - hashables$data <- sapply(hashables$data$get_datanames(), function(dn) { - if (hashables$data$is_pulled()) { + hashables$data <- if (inherits(hashables$data, "teal_data")) { + as.list(hashables$data@env) + } else if (inherits(hashables$data, "ddl")) { + attr(hashables$data, "datanames") # todo: no access to the $code in the current design + } else if (hashables$data$is_pulled()) { + sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { hashables$data$get_dataset(dn)$get_raw_data() - } else { - hashables$data$get_code(dn) - } - }, simplify = FALSE) + }) + } else { + hashables$data$get_code() + } + attr(filter, "app_id") <- rlang::hash(hashables) # check teal_slices From 2f1138463673df4c9ed21b7f7e95d62a8f8adb6f Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 23 Oct 2023 11:41:06 +0200 Subject: [PATCH 08/22] fix 2 after merge --- R/module_teal_with_splash.R | 8 ++------ 1 file changed, 2 insertions(+), 6 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index afe21fc317..9c196cb307 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -58,9 +58,7 @@ ui_teal_with_splash <- function(id, srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { checkmate::assert_multi_class(data, c("TealDataAbstract", "teal_data")) moduleServer(id, function(input, output, session) { - logger::log_trace( - "srv_teal_with_splash initializing module with data { paste(data$get_datanames(), collapse = ' ')}." - ) + logger::log_trace("srv_teal_with_splash initializing module with data { toString(get_dataname(data))}.") if (getOption("teal.show_js_log", default = FALSE)) { shinyjs::showLog() @@ -100,9 +98,7 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { } res <- srv_teal(id = "teal", modules = modules, raw_data = raw_data, filter = filter) - logger::log_trace( - "srv_teal_with_splash initialized the module with data { paste(data$get_datanames(), collapse = ' ') }." - ) + logger::log_trace("srv_teal_with_splash initialized module with data { toString(get_dataname(data))}.") return(res) }) } From ec575f967fee8d19a423f9b2c18491ffff3d6f6b Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Mon, 23 Oct 2023 17:14:52 +0200 Subject: [PATCH 09/22] teal_data instead of new_teal_data --- R/module_teal_with_splash.R | 22 ++++++++++++++-------- 1 file changed, 14 insertions(+), 8 deletions(-) diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index 9c196cb307..a475c07cc8 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -70,10 +70,13 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { raw_data <- if (inherits(data, "teal_data")) { reactiveVal(data) } else if (teal.data::is_pulled(data)) { - new_data <- new_teal_data( - data = lapply(data$get_datasets(), function(x) x$get_raw_data()), - code = data$get_code(), - keys = data$get_join_keys() + new_data <- do.call( + teal.data::teal_data, + c( + lapply(data$get_datasets(), function(x) x$get_raw_data()), + code = data$get_code(), + join_keys = data$get_join_keys() + ) ) reactiveVal(new_data) # will trigger by setting it } else { @@ -83,10 +86,13 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { if (!is.null(data)) { # raw_data is a reactive which returns data only when submit button clicked # otherwise it returns NULL - new_teal_data( - data = lapply(data$get_datasets(), function(x) x$get_raw_data()), - code = data$get_code(), - keys = data$get_join_keys() + do.call( + teal.data::teal_data, + c( + lapply(data$get_datasets(), function(x) x$get_raw_data()), + code = data$get_code(), + join_keys = data$get_join_keys() + ) ) } }) From c1cf841cdd1f1a155a37835fc0dbc0686356a1a5 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 25 Oct 2023 14:30:31 +0200 Subject: [PATCH 10/22] remove generic get_join_keys (duplicated with teal.data) --- NAMESPACE | 2 - R/tdata.R | 18 +------- man/get_join_keys.Rd | 18 ++------ vignettes/adding-support-for-reporting.Rmd | 29 +++++-------- vignettes/creating-custom-modules.Rmd | 4 +- vignettes/filter-panel.Rmd | 10 +++-- vignettes/including-adam-data-in-teal.Rmd | 43 +++++--------------- vignettes/including-general-data-in-teal.Rmd | 5 ++- vignettes/including-mae-data-in-teal.Rmd | 4 +- vignettes/preprocessing-data.Rmd | 8 +++- vignettes/teal-bs-themes.Rmd | 4 +- vignettes/teal.Rmd | 5 +-- 12 files changed, 44 insertions(+), 106 deletions(-) diff --git a/NAMESPACE b/NAMESPACE index fbf4258c0c..d38deef538 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,7 +2,6 @@ S3method(c,teal_slices) S3method(get_code,tdata) -S3method(get_join_keys,default) S3method(get_join_keys,tdata) S3method(get_metadata,default) S3method(get_metadata,tdata) @@ -21,7 +20,6 @@ export(TealReportCard) export(as.teal_slices) export(example_module) export(get_code_tdata) -export(get_join_keys) export(get_metadata) export(init) export(module) diff --git a/R/tdata.R b/R/tdata.R index 25fc845d38..55b4bda8fb 100644 --- a/R/tdata.R +++ b/R/tdata.R @@ -123,29 +123,13 @@ get_code_tdata <- function(data) { get_code(data) } - -#' Function to get join keys from a `tdata` object -#' @param data `tdata` - object to extract the join keys -#' @return Either `JoinKeys` object or `NULL` if no join keys -#' @export -get_join_keys <- function(data) { - UseMethod("get_join_keys", data) -} - - +#' Extract `JoinKeys` from `tdata` #' @rdname get_join_keys #' @export get_join_keys.tdata <- function(data) { attr(data, "join_keys") } - -#' @rdname get_join_keys -#' @export -get_join_keys.default <- function(data) { - stop("get_join_keys function not implemented for this object") -} - #' Function to get metadata from a `tdata` object #' @param data `tdata` - object to extract the data from #' @param dataname `character(1)` the dataset name whose metadata is requested diff --git a/man/get_join_keys.Rd b/man/get_join_keys.Rd index d69ef17f9c..0d00c5cc6f 100644 --- a/man/get_join_keys.Rd +++ b/man/get_join_keys.Rd @@ -1,23 +1,11 @@ % Generated by roxygen2: do not edit by hand % Please edit documentation in R/tdata.R -\name{get_join_keys} -\alias{get_join_keys} +\name{get_join_keys.tdata} \alias{get_join_keys.tdata} -\alias{get_join_keys.default} -\title{Function to get join keys from a \code{tdata} object} +\title{Extract \code{JoinKeys} from \code{tdata}} \usage{ -get_join_keys(data) - \method{get_join_keys}{tdata}(data) - -\method{get_join_keys}{default}(data) -} -\arguments{ -\item{data}{\code{tdata} - object to extract the join keys} -} -\value{ -Either \code{JoinKeys} object or \code{NULL} if no join keys } \description{ -Function to get join keys from a \code{tdata} object +Extract \code{JoinKeys} from \code{tdata} } diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index 70a9c69579..4897a41c57 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -54,10 +54,7 @@ Using `teal`, you can launch this example module with the following: ```{r, eval = FALSE} app <- init( - data = teal_data( - dataset("IRIS", iris), - dataset("MTCARS", mtcars) - ), + data = teal_data(IRIS = IRIS, MTCARS = mtcars), modules = teal_example_module() ) @@ -97,10 +94,7 @@ With these modifications, the module is now ready to be launched with `teal`: ```{r} app <- init( - data = teal_data( - dataset("IRIS", iris), - dataset("MTCARS", mtcars) - ), + data = teal_data(IRIS = iris, MTCARS = mtcars), modules = example_module_with_reporting() ) @@ -148,10 +142,7 @@ This updated module is now ready to be launched: ```{r} app <- init( - data = teal_data( - dataset("IRIS", iris), - dataset("MTCARS", mtcars) - ), + data = teal_data(IRIS = iris, MTCARS = mtcars), modules = example_module_with_reporting() ) @@ -201,10 +192,7 @@ example_module_with_reporting <- function(label = "example teal module") { ```{r} app <- init( - data = teal_data( - dataset("IRIS", iris), - dataset("MTCARS", mtcars) - ), + data = teal_data(IRIS = iris, MTCARS = mtcars), modules = example_module_with_reporting() ) @@ -323,9 +311,12 @@ example_reporter_module <- function(label = "Example") { app <- init( data = teal_data( - dataset("AIR", airquality, code = "data(airquality); AIR <- airquality"), - dataset("IRIS", iris, code = "data(iris); IRIS <- iris"), - check = FALSE + AIR = airquality, + IRI = iris, + code = "data(airquality) + AIR <- airquality + data(iris) + IRIS <- iris" ), modules = list( example_reporter_module(label = "with Reporter"), diff --git a/vignettes/creating-custom-modules.Rmd b/vignettes/creating-custom-modules.Rmd index 5a51551080..c9fd8735e5 100644 --- a/vignettes/creating-custom-modules.Rmd +++ b/vignettes/creating-custom-modules.Rmd @@ -177,8 +177,8 @@ library(teal) app <- init( data = teal_data( - dataset("IRIS", iris, code = "IRIS <- iris"), - check = TRUE + IRIS = iris, + code = "IRIS <- iris" ), modules = tm_histogram_example( label = "Simple Module", diff --git a/vignettes/filter-panel.Rmd b/vignettes/filter-panel.Rmd index 544e67546e..009b7f5aae 100644 --- a/vignettes/filter-panel.Rmd +++ b/vignettes/filter-panel.Rmd @@ -19,8 +19,9 @@ library(teal) app <- init( data = teal_data( - dataset("IRIS", iris, code = "IRIS <- iris"), - dataset("CARS", mtcars, code = "CARS <- mtcars") + IRIS = iris, CARS = mtcars, + code = "IRIS <- iris + CARS <- mtcars" ), modules = example_module(), filter = teal_slices( @@ -47,8 +48,9 @@ library(teal) app <- init( data = teal_data( - dataset("IRIS", iris, code = "IRIS <- iris"), - dataset("CARS", mtcars, code = "CARS <- mtcars") + IRIS = iris, CARS = mtcars, + code = "IRIS <- iris + CARS <- mtcars" ), modules = modules( example_module(label = "all datasets"), diff --git a/vignettes/including-adam-data-in-teal.Rmd b/vignettes/including-adam-data-in-teal.Rmd index 0197e923c9..428bff9f88 100644 --- a/vignettes/including-adam-data-in-teal.Rmd +++ b/vignettes/including-adam-data-in-teal.Rmd @@ -57,29 +57,21 @@ adtte$AVAL <- c( ) cdisc_data_obj <- cdisc_data( - cdisc_dataset( - dataname = "ADSL", - x = adsl, - code = ' + ADSL = adsl, ADTTE = adtte, + code = ' adsl <- data.frame( STUDYID = "study", USUBJID = 1:10, SEX = sample(c("F", "M"), 10, replace = TRUE), AGE = rpois(10, 40) - )' - ), - cdisc_dataset( - dataname = "ADTTE", - x = adtte, - code = ' + ) adtte <- rbind(adsl, adsl, adsl) adtte$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) adtte$AVAL <- c( - rnorm(10, mean = 700, sd = 200), - rnorm(10, mean = 400, sd = 100), - rnorm(10, mean = 450, sd = 200) + rnorm(10, mean = 700, sd = 200), # dummy OS level + rnorm(10, mean = 400, sd = 100), # dummy EFS level + rnorm(10, mean = 450, sd = 200) # dummy PFS level )' - ) ) class(cdisc_data_obj) ``` @@ -87,36 +79,21 @@ class(cdisc_data_obj) which is equivalent to: ```{r, message=FALSE} example_data <- cdisc_data( - cdisc_dataset( - dataname = "ADSL", - x = adsl, - code = ' + ADSL = adsl, ADTTE = adtte, + code = ' adsl <- data.frame( STUDYID = "study", USUBJID = 1:10, SEX = sample(c("F", "M"), 10, replace = TRUE), AGE = rpois(10, 40) - )', - keys = c("STUDYID", "USUBJID") - ), - cdisc_dataset( - dataname = "ADTTE", - x = adtte, - code = ' + ) adtte <- rbind(adsl, adsl, adsl) adtte$PARAMCD <- rep(c("OS", "EFS", "PFS"), each = 10) adtte$AVAL <- c( rnorm(10, mean = 700, sd = 200), rnorm(10, mean = 400, sd = 100), rnorm(10, mean = 450, sd = 200) - )', - keys = c("STUDYID", "USUBJID", "PARAMCD") - ), - join_keys = join_keys( - join_key("ADSL", "ADSL", c("STUDYID", "USUBJID")), - join_key("ADTTE", "ADTTE", c("USUBJID", "STUDYID", "PARAMCD")), - join_key("ADSL", "ADTTE", c("STUDYID", "USUBJID")) - ) + )' ) class(cdisc_data_obj) ``` diff --git a/vignettes/including-general-data-in-teal.Rmd b/vignettes/including-general-data-in-teal.Rmd index 30251d6aaa..69d8f81d9e 100644 --- a/vignettes/including-general-data-in-teal.Rmd +++ b/vignettes/including-general-data-in-teal.Rmd @@ -19,8 +19,9 @@ library(teal) app <- init( data = teal_data( - dataset("IRIS", iris, code = "IRIS <- iris"), - dataset("CARS", mtcars, code = "CARS <- mtcars") + IRIS = iris, CARS = mtcars, + code = "IRIS <- iris + CARS <- mtcars" ), modules = example_module() ) diff --git a/vignettes/including-mae-data-in-teal.Rmd b/vignettes/including-mae-data-in-teal.Rmd index bb4f5501ef..c614dc7a1f 100644 --- a/vignettes/including-mae-data-in-teal.Rmd +++ b/vignettes/including-mae-data-in-teal.Rmd @@ -21,10 +21,8 @@ The example below represents an application including `MultiAssayExperiment` dat library(teal) utils::data(miniACC, package = "MultiAssayExperiment") -mae_d <- dataset("MAE", miniACC, metadata = list(type = "example")) - app <- init( - data = teal_data(mae_d), + data = teal_data(MAE = miniACC), modules = example_module() ) diff --git a/vignettes/preprocessing-data.Rmd b/vignettes/preprocessing-data.Rmd index 3da46d6e21..b2fb8a4ec3 100644 --- a/vignettes/preprocessing-data.Rmd +++ b/vignettes/preprocessing-data.Rmd @@ -35,7 +35,10 @@ new_iris <- transform(iris, id = seq_len(nrow(iris))) # Date: Wed, 25 Oct 2023 14:32:20 +0200 Subject: [PATCH 11/22] add docs --- R/tdata.R | 1 + man/get_join_keys.Rd | 3 +++ 2 files changed, 4 insertions(+) diff --git a/R/tdata.R b/R/tdata.R index 55b4bda8fb..14ae07f389 100644 --- a/R/tdata.R +++ b/R/tdata.R @@ -125,6 +125,7 @@ get_code_tdata <- function(data) { #' Extract `JoinKeys` from `tdata` #' @rdname get_join_keys +#' @param data (`tdata`) object #' @export get_join_keys.tdata <- function(data) { attr(data, "join_keys") diff --git a/man/get_join_keys.Rd b/man/get_join_keys.Rd index 0d00c5cc6f..5c54686678 100644 --- a/man/get_join_keys.Rd +++ b/man/get_join_keys.Rd @@ -6,6 +6,9 @@ \usage{ \method{get_join_keys}{tdata}(data) } +\arguments{ +\item{data}{(\code{tdata}) object} +} \description{ Extract \code{JoinKeys} from \code{tdata} } From a035f8487e7864397c503b555d01264af6d47af6 Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Wed, 25 Oct 2023 12:35:48 +0000 Subject: [PATCH 12/22] [skip actions] Restyle files --- vignettes/adding-support-for-reporting.Rmd | 2 +- vignettes/creating-custom-modules.Rmd | 2 +- vignettes/including-general-data-in-teal.Rmd | 2 +- vignettes/preprocessing-data.Rmd | 2 +- 4 files changed, 4 insertions(+), 4 deletions(-) diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index 4897a41c57..83ebbbb18c 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -311,7 +311,7 @@ example_reporter_module <- function(label = "Example") { app <- init( data = teal_data( - AIR = airquality, + AIR = airquality, IRI = iris, code = "data(airquality) AIR <- airquality diff --git a/vignettes/creating-custom-modules.Rmd b/vignettes/creating-custom-modules.Rmd index c9fd8735e5..9e68150c0e 100644 --- a/vignettes/creating-custom-modules.Rmd +++ b/vignettes/creating-custom-modules.Rmd @@ -177,7 +177,7 @@ library(teal) app <- init( data = teal_data( - IRIS = iris, + IRIS = iris, code = "IRIS <- iris" ), modules = tm_histogram_example( diff --git a/vignettes/including-general-data-in-teal.Rmd b/vignettes/including-general-data-in-teal.Rmd index 69d8f81d9e..75c14cbd80 100644 --- a/vignettes/including-general-data-in-teal.Rmd +++ b/vignettes/including-general-data-in-teal.Rmd @@ -19,7 +19,7 @@ library(teal) app <- init( data = teal_data( - IRIS = iris, CARS = mtcars, + IRIS = iris, CARS = mtcars, code = "IRIS <- iris CARS <- mtcars" ), diff --git a/vignettes/preprocessing-data.Rmd b/vignettes/preprocessing-data.Rmd index b2fb8a4ec3..38848a5ea5 100644 --- a/vignettes/preprocessing-data.Rmd +++ b/vignettes/preprocessing-data.Rmd @@ -36,7 +36,7 @@ new_iris <- transform(iris, id = seq_len(nrow(iris))) app <- init( data = teal_data( - new_iris = new_iris, + new_iris = new_iris, code = get_code(file = "app.R") ), modules = example_module() From c7ce543d45c34341813e11f02744fc087ad92792 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Wed, 25 Oct 2023 14:44:41 +0200 Subject: [PATCH 13/22] fix hashing of ddl --- R/init.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/init.R b/R/init.R index f36e464c93..d53faf3f20 100644 --- a/R/init.R +++ b/R/init.R @@ -182,7 +182,7 @@ init <- function(data, hashables$data <- if (inherits(hashables$data, "teal_data")) { as.list(hashables$data@env) } else if (inherits(hashables$data, "ddl")) { - attr(hashables$data, "datanames") # todo: no access to the $code in the current design + attr(hashables$data, "code") } else if (hashables$data$is_pulled()) { sapply(get_dataname(hashables$data), simplify = FALSE, function(dn) { hashables$data$get_dataset(dn)$get_raw_data() From 1e061f157730914383ff990d4a3fa4d5c2d0e9d2 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Thu, 26 Oct 2023 13:48:22 +0200 Subject: [PATCH 14/22] fix pkgdown --- _pkgdown.yml | 1 - 1 file changed, 1 deletion(-) diff --git a/_pkgdown.yml b/_pkgdown.yml index c75a61786d..01209c9ae4 100644 --- a/_pkgdown.yml +++ b/_pkgdown.yml @@ -114,7 +114,6 @@ reference: contents: - tdata - get_code_tdata - - get_join_keys - get_metadata - tdata2env - show_rcode_modal From 56424e9796be5aa2fcd1ba184316d3de7f8d1fe6 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 27 Oct 2023 08:08:30 +0200 Subject: [PATCH 15/22] fix pkgdown --- R/tdata.R | 1 + man/get_join_keys.Rd | 1 + 2 files changed, 2 insertions(+) diff --git a/R/tdata.R b/R/tdata.R index 14ae07f389..d3fe151b95 100644 --- a/R/tdata.R +++ b/R/tdata.R @@ -126,6 +126,7 @@ get_code_tdata <- function(data) { #' Extract `JoinKeys` from `tdata` #' @rdname get_join_keys #' @param data (`tdata`) object +#' @keywords internal #' @export get_join_keys.tdata <- function(data) { attr(data, "join_keys") diff --git a/man/get_join_keys.Rd b/man/get_join_keys.Rd index 5c54686678..977a4b3145 100644 --- a/man/get_join_keys.Rd +++ b/man/get_join_keys.Rd @@ -12,3 +12,4 @@ \description{ Extract \code{JoinKeys} from \code{tdata} } +\keyword{internal} From 6ec2c22d9c6bc559f5aa4f8bb5e1019afa41c00c Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 27 Oct 2023 15:40:29 +0200 Subject: [PATCH 16/22] resolve_modules_datanames to utils.R --- R/init.R | 27 +-------------------- R/utils.R | 40 ++++++++++++++++++++++++++++++++ man/resolve_modules_datanames.Rd | 20 ++++++++++++++++ 3 files changed, 61 insertions(+), 26 deletions(-) create mode 100644 man/resolve_modules_datanames.Rd diff --git a/R/init.R b/R/init.R index 5008e7e092..b697e2829b 100644 --- a/R/init.R +++ b/R/init.R @@ -145,32 +145,7 @@ init <- function(data, # resolve modules datanames datanames <- teal.data::get_dataname(data) join_keys <- teal.data::get_join_keys(data) - resolve_modules_datanames <- function(modules) { - if (inherits(modules, "teal_modules")) { - modules$children <- sapply(modules$children, resolve_modules_datanames, simplify = FALSE) - modules - } else { - modules$datanames <- if (identical(modules$datanames, "all")) { - datanames - } else if (is.character(modules$datanames)) { - extra_datanames <- setdiff(modules$datanames, datanames) - if (length(extra_datanames)) { - stop( - sprintf( - "Module %s has datanames that are not available in a 'data':\n %s not in %s", - modules$label, - toString(extra_datanames), - toString(datanames) - ) - ) - } - datanames_adjusted <- intersect(modules$datanames, datanames) - include_parent_datanames(dataname = datanames_adjusted, join_keys = join_keys) - } - modules - } - } - modules <- resolve_modules_datanames(modules = modules) + modules <- resolve_modules_datanames(modules = modules, datanames = datanames, join_keys = join_keys) if (!inherits(filter, "teal_slices")) { checkmate::assert_subset(names(filter), choices = datanames) diff --git a/R/utils.R b/R/utils.R index 730153afbf..4c0e4adf6d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -100,3 +100,43 @@ report_card_template <- function(title, label, description = NULL, with_filter, if (with_filter) card$append_fs(filter_panel_api$get_filter_state()) card } +#' Resolve the datanames for the modules +#' +#' Modifies `module$datanames` to include parent datanames (taken from join_keys). +#' When `datanames` is set to `"all"` it is replaced with all available datanames. +#' @param modules (`teal_modules`) object +#' @param datanames (`character`) datanames available in the `data` object +#' @param join_keys (`JoinKeys`) object +#' @retun `teal_modules` with resolved datanames +#' @keywords internal +resolve_modules_datanames <- function(modules, datanames, join_keys) { + if (inherits(modules, "teal_modules")) { + modules$children <- sapply( + modules$children, + resolve_modules_datanames, + simplify = FALSE, + datanames = datanames, + join_keys = join_keys + ) + modules + } else { + modules$datanames <- if (identical(modules$datanames, "all")) { + datanames + } else if (is.character(modules$datanames)) { + extra_datanames <- setdiff(modules$datanames, datanames) + if (length(extra_datanames)) { + stop( + sprintf( + "Module %s has datanames that are not available in a 'data':\n %s not in %s", + modules$label, + toString(extra_datanames), + toString(datanames) + ) + ) + } + datanames_adjusted <- intersect(modules$datanames, datanames) + include_parent_datanames(dataname = datanames_adjusted, join_keys = join_keys) + } + modules + } +} \ No newline at end of file diff --git a/man/resolve_modules_datanames.Rd b/man/resolve_modules_datanames.Rd new file mode 100644 index 0000000000..953f44a90b --- /dev/null +++ b/man/resolve_modules_datanames.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utils.R +\name{resolve_modules_datanames} +\alias{resolve_modules_datanames} +\title{Resolve the datanames for the modules} +\usage{ +resolve_modules_datanames(modules, datanames, join_keys) +} +\arguments{ +\item{modules}{(\code{teal_modules}) object} + +\item{datanames}{(\code{character}) datanames available in the \code{data} object} + +\item{join_keys}{(\code{JoinKeys}) object} +} +\description{ +Modifies \code{module$datanames} to include parent datanames (taken from join_keys). +When \code{datanames} is set to \code{"all"} it is replaced with all available datanames. +} +\keyword{internal} From 45d29853383b1b6b10b1ccedc8415e9b4ceb99af Mon Sep 17 00:00:00 2001 From: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Date: Fri, 27 Oct 2023 13:43:48 +0000 Subject: [PATCH 17/22] [skip actions] Restyle files --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 4c0e4adf6d..fa1faee7d8 100644 --- a/R/utils.R +++ b/R/utils.R @@ -139,4 +139,4 @@ resolve_modules_datanames <- function(modules, datanames, join_keys) { } modules } -} \ No newline at end of file +} From 1a6e11da97ea582a7f2d9bdc4b37a25ae1ca1952 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 27 Oct 2023 15:44:26 +0200 Subject: [PATCH 18/22] rerun From e5ef022eaa3d452c53285cb744e0d556f617a809 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 27 Oct 2023 15:49:38 +0200 Subject: [PATCH 19/22] fix spelling --- R/utils.R | 10 +++++----- man/resolve_modules_datanames.Rd | 11 +++++++---- 2 files changed, 12 insertions(+), 9 deletions(-) diff --git a/R/utils.R b/R/utils.R index fa1faee7d8..356f0dc47c 100644 --- a/R/utils.R +++ b/R/utils.R @@ -100,14 +100,14 @@ report_card_template <- function(title, label, description = NULL, with_filter, if (with_filter) card$append_fs(filter_panel_api$get_filter_state()) card } -#' Resolve the datanames for the modules +#' Resolve `datanames` for the modules #' -#' Modifies `module$datanames` to include parent datanames (taken from join_keys). -#' When `datanames` is set to `"all"` it is replaced with all available datanames. +#' Modifies `module$datanames` to include names of the parent dataset (taken from `join_keys`). +#' When `datanames` is set to `"all"` it is replaced with all available datasets names. #' @param modules (`teal_modules`) object -#' @param datanames (`character`) datanames available in the `data` object +#' @param datanames (`character`) names of datasets available in the `data` object #' @param join_keys (`JoinKeys`) object -#' @retun `teal_modules` with resolved datanames +#' @return `teal_modules` with resolved `datanames` #' @keywords internal resolve_modules_datanames <- function(modules, datanames, join_keys) { if (inherits(modules, "teal_modules")) { diff --git a/man/resolve_modules_datanames.Rd b/man/resolve_modules_datanames.Rd index 953f44a90b..0509844daf 100644 --- a/man/resolve_modules_datanames.Rd +++ b/man/resolve_modules_datanames.Rd @@ -2,19 +2,22 @@ % Please edit documentation in R/utils.R \name{resolve_modules_datanames} \alias{resolve_modules_datanames} -\title{Resolve the datanames for the modules} +\title{Resolve \code{datanames} for the modules} \usage{ resolve_modules_datanames(modules, datanames, join_keys) } \arguments{ \item{modules}{(\code{teal_modules}) object} -\item{datanames}{(\code{character}) datanames available in the \code{data} object} +\item{datanames}{(\code{character}) names of datasets available in the \code{data} object} \item{join_keys}{(\code{JoinKeys}) object} } +\value{ +\code{teal_modules} with resolved \code{datanames} +} \description{ -Modifies \code{module$datanames} to include parent datanames (taken from join_keys). -When \code{datanames} is set to \code{"all"} it is replaced with all available datanames. +Modifies \code{module$datanames} to include names of the parent dataset (taken from \code{join_keys}). +When \code{datanames} is set to \code{"all"} it is replaced with all available datasets names. } \keyword{internal} From c5937341436726ebd2043eaf41f86dfe31d75baa Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 27 Oct 2023 15:50:59 +0200 Subject: [PATCH 20/22] skipping lint of a long function --- R/utils.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/utils.R b/R/utils.R index 356f0dc47c..a4a31f2a5d 100644 --- a/R/utils.R +++ b/R/utils.R @@ -55,7 +55,7 @@ include_parent_datanames <- function(dataname, join_keys) { #' @param x (`teal_data`) object #' @return (`FilteredData`) object #' @keywords internal -teal_data_to_filtered_data <- function(x) { # nolint +teal_data_to_filtered_data <- function(x) { checkmate::assert_class(x, "teal_data") datanames <- x@datanames From 2b13b23d794e3b1f6c11478a50a880242409a0f1 Mon Sep 17 00:00:00 2001 From: go_gonzo Date: Fri, 27 Oct 2023 15:59:20 +0200 Subject: [PATCH 21/22] addressing old comments --- R/module_teal.R | 2 +- R/module_teal_with_splash.R | 9 ++++----- 2 files changed, 5 insertions(+), 6 deletions(-) diff --git a/R/module_teal.R b/R/module_teal.R index 359e83827e..413e47d349 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -161,7 +161,7 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { ) env <- environment() - datasets_reactive <- eventReactive(raw_data(), ignoreNULL = TRUE, { + datasets_reactive <- eventReactive(raw_data(), { env$progress <- shiny::Progress$new(session) env$progress$set(0.25, message = "Setting data") diff --git a/R/module_teal_with_splash.R b/R/module_teal_with_splash.R index a475c07cc8..01348381b2 100644 --- a/R/module_teal_with_splash.R +++ b/R/module_teal_with_splash.R @@ -31,7 +31,7 @@ ui_teal_with_splash <- function(id, # Shiny app does not time out. splash_ui <- if (inherits(data, "teal_data")) { div() - } else if (teal.data::is_pulled(data)) { + } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { div() } else { message("App was initialized with delayed data loading.") @@ -64,12 +64,11 @@ srv_teal_with_splash <- function(id, data, modules, filter = teal_slices()) { shinyjs::showLog() } - # raw_data contains TealDataAbstract, i.e. R6 object and container for data - # reactive to get data through delayed loading - # we must leave it inside the server because of callModule which needs to pick up the right session + # raw_data contains teal_data object + # either passed to teal::init or returned from ddl raw_data <- if (inherits(data, "teal_data")) { reactiveVal(data) - } else if (teal.data::is_pulled(data)) { + } else if (inherits(data, "TealDataAbstract") && teal.data::is_pulled(data)) { new_data <- do.call( teal.data::teal_data, c( From 2d688f28ee27f0dc93064722a46b7e24802753f9 Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Mon, 30 Oct 2023 13:42:06 +0100 Subject: [PATCH 22/22] fix typo Signed-off-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> --- vignettes/adding-support-for-reporting.Rmd | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index 83ebbbb18c..b28fbd32f4 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -54,7 +54,7 @@ Using `teal`, you can launch this example module with the following: ```{r, eval = FALSE} app <- init( - data = teal_data(IRIS = IRIS, MTCARS = mtcars), + data = teal_data(IRIS = iris, MTCARS = mtcars), modules = teal_example_module() )