Refactor (#992)

part of #937 --------- Signed-off-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Signed-off-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Signed-off-by: kartikeya kirar <kirar.kartikeya1@gmail.com> Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Co-authored-by: Dony Unardi <donyunardi@gmail.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: Aleksander Chlebowski <aleksander.chlebowski@contractors.roche.com> Co-authored-by: kartikeya kirar <kirar.kartikeya1@gmail.com> Co-authored-by: Vedha Viyash <49812166+vedhav@users.noreply.github.com> Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
insightsengineering · Dec 8, 2023 · f69e634 · f69e634
1 parent ac443fe
commit f69e634
Show file tree

Hide file tree

Showing 63 changed files with 958 additions and 1,128 deletions.
diff --git a/.gitignore b/.gitignore
@@ -27,3 +27,4 @@ tmp.*
 vignettes/*.R
 vignettes/*.html
 vignettes/*.md
+inst/doc
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -31,9 +31,9 @@ BugReports: https://github.com/insightsengineering/teal/issues
 Depends:
     R (>= 4.0),
     shiny (>= 1.7.0),
-    teal.data (>= 0.3.0.9011),
-    teal.slice (>= 0.4.0.9023),
-    teal.transform (>= 0.4.0.9007)
+    teal.data (>= 0.3.0.9017),
+    teal.slice (>= 0.4.0.9027),
+    teal.transform (>= 0.4.0.9010)
 Imports:
     checkmate (>= 2.1.0),
     jsonlite,
@@ -51,8 +51,6 @@ Imports:
     utils
 Suggests:
     bslib,
-    covr,
-    dplyr (>= 1.0.5),
     knitr (>= 1.42),
     MultiAssayExperiment,
     R6,
@@ -70,8 +68,8 @@ Config/Needs/verdepcheck: rstudio/shiny, insightsengineering/teal.data,
     mllg/checkmate, jeroen/jsonlite, r-lib/lifecycle, daroczig/logger,
     tidyverse/magrittr, r-lib/rlang, daattali/shinyjs,
     insightsengineering/teal.logger, insightsengineering/teal.reporter,
-    insightsengineering/teal.widgets, rstudio/bslib, r-lib/covr,
-    tidyverse/dplyr, yihui/knitr, bioc::MultiAssayExperiment, r-lib/R6,
+    insightsengineering/teal.widgets, rstudio/bslib,
+    yihui/knitr, bioc::MultiAssayExperiment, r-lib/R6,
     rstudio/rmarkdown, rstudio/shinyvalidate,
     insightsengineering/teal.code, r-lib/testthat, r-lib/withr,
     yaml=vubiostat/r-yaml

diff --git a/NAMESPACE b/NAMESPACE
@@ -1,7 +1,6 @@
 # Generated by roxygen2: do not edit by hand
 
 S3method(c,teal_slices)
-S3method(get_code,tdata)
 S3method(get_metadata,default)
 S3method(get_metadata,tdata)
 S3method(join_keys,tdata)
@@ -19,6 +18,7 @@ S3method(within,teal_data_module)
 export("%>%")
 export(TealReportCard)
 export(as.teal_slices)
+export(as_tdata)
 export(example_module)
 export(get_code_tdata)
 export(get_metadata)
@@ -48,7 +48,7 @@ import(shiny)
 import(teal.data)
 import(teal.slice)
 import(teal.transform)
-importFrom(lifecycle,deprecate_soft)
+importFrom(lifecycle,badge)
 importFrom(magrittr,"%>%")
 importFrom(methods,setMethod)
 importFrom(stats,setNames)

diff --git a/NEWS.md b/NEWS.md
@@ -5,6 +5,13 @@
 * `data` argument in `init` now accepts `teal_data` and `teal_data_module`.
 * Added `landing_popup_module` function which creates a module that will display a popup when the app starts. The popup will block access to the app until it is dismissed.
 * Filter state snapshots can now be uploaded from file. See `?snapshot`.
+* Added `as_tdata` function to facilitate migration of modules to the new `teal_data` class.
+
+### Breaking changes
+
+* `tdata` has been deprecated and replaced with `teal_data`. Support for `tdata` passed to the `data` argument in `module(server)` will be removed in the next release.
+* `module(ui)` argument no longer accepts `data` and `datasets` arguments. All data dependent logic should be set in the `server` function.
+* `module(server)` argument deprecated `datasets` argument. `teal_module`s' `server` functions should accept `data` (`teal_data`) instead.
 
 ### Miscellaneous
 

diff --git a/R/dummy_functions.R b/R/dummy_functions.R
@@ -78,10 +78,7 @@ example_datasets <- function() { # nolint
 #' @return A `teal` module which can be included in the `modules` argument to [teal::init()].
 #' @examples
 #' app <- init(
-#'   data = teal_data(
-#'     dataset("IRIS", iris),
-#'     dataset("MTCARS", mtcars)
-#'   ),
+#'   data = teal_data(IRIS = iris, MTCARS = mtcars),
 #'   modules = example_module()
 #' )
 #' if (interactive()) {
@@ -93,22 +90,27 @@ example_module <- function(label = "example teal module", datanames = "all") {
   module(
     label,
     server = function(id, data) {
-      checkmate::assert_class(data, "tdata")
+      checkmate::assert_class(data(), "teal_data")
       moduleServer(id, function(input, output, session) {
-        output$text <- renderPrint(data[[input$dataname]]())
+        ns <- session$ns
+        updateSelectInput(session, "dataname", choices = isolate(teal.data::datanames(data())))
+        output$text <- renderPrint({
+          req(input$dataname)
+          data()[[input$dataname]]
+        })
         teal.widgets::verbatim_popup_srv(
           id = "rcode",
-          verbatim_content = attr(data, "code")(),
+          verbatim_content = reactive(teal.code::get_code(data())),
           title = "Association Plot"
         )
       })
     },
-    ui = function(id, data) {
+    ui = function(id) {
       ns <- NS(id)
       teal.widgets::standard_layout(
         output = verbatimTextOutput(ns("text")),
         encoding = div(
-          selectInput(ns("dataname"), "Choose a dataset", choices = names(data)),
+          selectInput(ns("dataname"), "Choose a dataset", choices = NULL),
           teal.widgets::verbatim_popup_ui(ns("rcode"), "Show R code")
         )
       )

diff --git a/R/get_rcode_utils.R b/R/get_rcode_utils.R
@@ -38,39 +38,38 @@ get_rcode_str_install <- function() {
 #' @param datasets (`FilteredData`) object
 #' @param hashes named (`list`) of hashes per dataset
 #'
-#' @return `character(3)` containing the following elements:
+#' @return Character string concatenated from the following elements:
 #'  - data pre-processing code (from `data` argument in `init`)
 #'  - hash check of loaded objects
-#'  - filter code
+#'  - filter code (if any)
 #'
 #' @keywords internal
 get_datasets_code <- function(datanames, datasets, hashes) {
+  # preprocessing code
   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")
+  } else {
+    str_prepro <- paste(str_prepro, collapse = "\n")
   }
 
-  str_hash <- paste(
-    paste0(
-      vapply(
-        datanames,
-        function(dataname) {
-          sprintf(
-            "stopifnot(%s == %s)",
-            deparse1(bquote(rlang::hash(.(as.name(dataname))))),
-            deparse1(hashes[[dataname]])
-          )
-        },
-        character(1)
-      ),
-      collapse = "\n"
-    ),
-    "\n\n"
-  )
+  # hash checks
+  str_hash <- vapply(datanames, function(dataname) {
+    sprintf(
+      "stopifnot(%s == %s)",
+      deparse1(bquote(rlang::hash(.(as.name(dataname))))),
+      deparse1(hashes[[dataname]])
+    )
+  }, character(1))
+  str_hash <- paste(str_hash, collapse = "\n")
 
+  # filter expressions
   str_filter <- teal.slice::get_filter_expr(datasets, datanames)
+  if (str_filter == "") {
+    str_filter <- character(0)
+  }
 
-  c(str_prepro, str_hash, str_filter)
+  # concatenate all code
+  str_code <- paste(c(str_prepro, str_hash, str_filter), collapse = "\n\n")
+  sprintf("%s\n", str_code)
 }
diff --git a/R/init.R b/R/init.R
@@ -10,16 +10,10 @@
 #' End-users: This is the most important function for you to start a
 #' teal app that is composed out of teal modules.
 #'
-#' @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()],
-#' [teal.data::cdisc_dataset()], [teal.data::dataset()], [teal.data::dataset_connector()] or
-#' [teal.data::cdisc_dataset_connector()] or [teal_data_module()] or a single `data.frame` or
-#' a `MultiAssayExperiment`
-#' or a list of the previous objects or function returning a named list.
-#' NOTE: teal does not guarantee reproducibility of the code when names of the list elements
-#' do not match the original object names. To ensure reproducibility please use [teal.data::teal_data()]
-#' or [teal.data::cdisc_data()] with `check = TRUE` enabled.
+#' @param data (`teal_data`, `teal_data_module`, `named list`)\cr
+#' `teal_data` object as returned by [teal.data::teal_data()] or
+#' `teal_data_modules` or simply a list of a named list of objects
+#' (`data.frame` or `MultiAssayExperiment`).
 #' @param modules (`list`, `teal_modules` or `teal_module`)\cr
 #'   nested list of `teal_modules` or `teal_module` objects or a single
 #'   `teal_modules` or `teal_module` object. These are the specific output modules which
@@ -50,13 +44,10 @@
 #' @include modules.R
 #'
 #' @examples
-#' new_iris <- transform(iris, id = seq_len(nrow(iris)))
-#' new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars)))
-#'
 #' app <- init(
 #'   data = teal_data(
-#'     dataset("new_iris", new_iris),
-#'     dataset("new_mtcars", new_mtcars),
+#'     new_iris = transform(iris, id = seq_len(nrow(iris))),
+#'     new_mtcars = transform(mtcars, id = seq_len(nrow(mtcars))),
 #'     code = "
 #'       new_iris <- transform(iris, id = seq_len(nrow(iris)))
 #'       new_mtcars <- transform(mtcars, id = seq_len(nrow(mtcars)))
@@ -74,7 +65,7 @@
 #'       "Iris Sepal.Length histogram",
 #'       server = function(input, output, session, data) {
 #'         output$hist <- renderPlot(
-#'           hist(data[["new_iris"]]()$Sepal.Length)
+#'           hist(data()[["new_iris"]]$Sepal.Length)
 #'         )
 #'       },
 #'       ui = function(id, ...) {
@@ -111,11 +102,22 @@ init <- function(data,
                  footer = tags$p(),
                  id = character(0)) {
   logger::log_trace("init initializing teal app with: data ({ class(data)[1] }).")
-  if (!inherits(data, c("TealData", "teal_data", "teal_data_module"))) {
-    data <- teal.data::to_relational_data(data = data)
+  if (is.list(data) && !inherits(data, "teal_data_module")) {
+    checkmate::assert_list(data, names = "named")
+    data <- do.call(teal.data::teal_data, data)
+  }
+  if (inherits(data, "TealData")) {
+    lifecycle::deprecate_stop(
+      when = "0.99.0",
+      what = "init(data)",
+      paste(
+        "TealData is no longer supported. Use teal_data() instead.",
+        "Please follow migration instructions https://github.com/insightsengineering/teal/discussions/988."
+      )
+    )
   }
 
-  checkmate::assert_multi_class(data, c("TealData", "teal_data", "teal_data_module"))
+  checkmate::assert_multi_class(data, c("teal_data", "teal_data_module"))
   checkmate::assert_multi_class(modules, c("teal_module", "list", "teal_modules"))
   checkmate::assert_string(title, null.ok = TRUE)
   checkmate::assert(
@@ -147,12 +149,6 @@ init <- function(data,
     as.list(hashables$data@env)
   } else if (inherits(data, "teal_data_module")) {
     body(data$server)
-  } 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()
   }
 
   attr(filter, "app_id") <- rlang::hash(hashables)
@@ -218,10 +214,6 @@ init <- function(data,
         landing_module <- landing[[1L]]
         do.call(landing_module$server, c(list(id = "landing_module_shiny_id"), landing_module$server_args))
       }
-      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
@@ -115,15 +115,6 @@ ui_nested_tabs.teal_module <- function(id, modules, datasets, depth = 0L, is_mod
   args <- isolate(teal.transform::resolve_delayed(modules$ui_args, datasets))
   args <- c(list(id = ns("module")), args)
 
-  if (is_arg_used(modules$ui, "datasets")) {
-    args <- c(args, datasets = datasets)
-  }
-
-  if (is_arg_used(modules$ui, "data")) {
-    data <- .datasets_to_data(modules, datasets)
-    args <- c(args, data = list(data))
-  }
-
   teal_ui <- tags$div(
     id = id,
     class = "teal_module",
@@ -243,7 +234,7 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
     }
 
     if (is_arg_used(modules$server, "data")) {
-      data <- .datasets_to_data(modules, datasets, trigger_data)
+      data <- eventReactive(trigger_data(), .datasets_to_data(modules, datasets))
       args <- c(args, data = list(data))
     }
 
@@ -252,13 +243,6 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
       args <- c(args, filter_panel_api = filter_panel_api)
     }
 
-    if (is_arg_used(modules$server, "datasets") && is_arg_used(modules$server, "data")) {
-      warning(
-        "Module '", modules$label, "' has `data` and `datasets` arguments in the formals.",
-        "\nIt's recommended to use `data` to work with filtered objects."
-      )
-    }
-
     # observe the trigger_module above to induce the module once the renderUI is triggered
     observeEvent(
       ignoreNULL = TRUE,
@@ -277,25 +261,20 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
   })
 }
 
-#' Convert `FilteredData` to reactive list of datasets of the `tdata` type.
+#' Convert `FilteredData` to reactive list of datasets of the `teal_data` type.
 #'
-#' Converts `FilteredData` object to `tdata` object containing datasets needed for a specific module.
+#' Converts `FilteredData` object to `teal_data` object containing datasets needed for a specific module.
 #' Please note that if module needs dataset which has a parent, then parent will be also returned.
 #' A hash per `dataset` is calculated internally and returned in the code.
 #'
 #' @param module (`teal_module`) module where needed filters are taken from
 #' @param datasets (`FilteredData`) object where needed data are taken from
-#' @param trigger_data (`reactiveVal`) to trigger getting the filtered data
-#' @return list of reactive datasets with following attributes:
-#' - `code` (`character`) containing datasets reproducible code.
-#' - `join_keys` (`join_keys`) containing relationships between datasets.
-#' - `metadata` (`list`) containing metadata of datasets.
+#' @return A `teal_data` object.
 #'
 #' @keywords internal
-.datasets_to_data <- function(module, datasets, trigger_data = reactiveVal(1L)) {
+.datasets_to_data <- function(module, datasets) {
   checkmate::assert_class(module, "teal_module")
   checkmate::assert_class(datasets, "FilteredData")
-  checkmate::assert_class(trigger_data, "reactiveVal")
 
   datanames <- if (is.null(module$datanames) || identical(module$datanames, "all")) {
     datasets$datanames()
@@ -304,29 +283,19 @@ srv_nested_tabs.teal_module <- function(id, datasets, modules, is_module_specifi
   }
 
   # list of reactive filtered data
-  data <- sapply(
-    datanames,
-    function(x) eventReactive(trigger_data(), datasets$get_data(x, filtered = TRUE)),
-    simplify = FALSE
-  )
+  data <- sapply(datanames, function(x) datasets$get_data(x, filtered = TRUE), simplify = FALSE)
 
   hashes <- calculate_hashes(datanames, datasets)
-  metadata <- sapply(datanames, datasets$get_metadata, simplify = FALSE)
 
-  new_tdata(
-    data,
-    eventReactive(
-      trigger_data(),
-      {
-        c(
-          get_rcode_str_install(),
-          get_rcode_libraries(),
-          get_datasets_code(datanames, datasets, hashes)
-        )
-      }
-    ),
-    datasets$get_join_keys(),
-    metadata
+  code <- c(
+    get_rcode_str_install(),
+    get_rcode_libraries(),
+    get_datasets_code(datanames, datasets, hashes)
+  )
+
+  do.call(
+    teal.data::teal_data,
+    args = c(data, code = list(code), join_keys = list(datasets$get_join_keys()[datanames]))
   )
 }