Introduce teal_data class

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(landing_popup_module)

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(

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`
@@ -114,9 +114,11 @@ 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)
 
-  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(
@@ -142,7 +144,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)
@@ -151,6 +153,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)
       }
@@ -170,13 +183,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, "code")
+  } 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
@@ -231,8 +249,10 @@ init <- function(data,
         landing_module <- landing[[1L]]
         do.call(landing_module$server, c(list(id = "landing_module_shiny_id"), landing_module$server_args))
       }
-      # 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)
     }

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

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.
@@ -160,18 +160,14 @@ 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")
 
       # 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)
@@ -184,25 +180,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_data_to_filtered_data(raw_data())
 
           # set initial filters
           slices <- Filter(x = filter, f = function(x) {

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.")
@@ -52,36 +52,59 @@ 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_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 = ' ')}."
-    )
+    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()
     }
 
-    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)) {
+      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 {
-      raw_data <- data$get_server()(id = "startapp_module")
+      raw_data_old <- data$get_server()(id = "startapp_module")
+      raw_data <- reactive({
+        data <- raw_data_old()
+        if (!is.null(data)) {
+          # raw_data is a reactive which returns data only when submit button clicked
+          # otherwise it returns NULL
+          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()
+            )
+          )
+        }
+      })
+
       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)
-    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)
   })
 }

R/tdata.R

@@ -123,29 +123,14 @@ 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
+#' @param data (`tdata`) object
 #' @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

R/utils.R

@@ -47,6 +47,29 @@ 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
+  )
+}
+
 #' Template Function for `TealReportCard` Creation and Customization
 #'
 #' This function generates a report card with a title,

_pkgdown.yml

@@ -114,7 +114,6 @@ reference:
     contents:
       - tdata
       - get_code_tdata
-      - get_join_keys
       - get_metadata
       - tdata2env
       - show_rcode_modal