Change name of the raw (unfiltered object)

NEWS.md

@@ -22,6 +22,7 @@
 * Easier way of to call `javascript` events by setting `$(document).ready(function() { ... })`. #1114
 * Provided progress bar for modules loading and data filtering during teal app startup.
 * Filter mapping display has a separate icon in the tab.
+* Environment of the `data` passed to the `teal_module`'s server consists unfiltered datasets contained in `.raw_data`.
 
 # teal 0.15.2
 

R/dummy_functions.R

@@ -20,10 +20,7 @@ example_module <- function(label = "example teal module", datanames = "all", tra
     server = function(id, data) {
       checkmate::assert_class(isolate(data()), "teal_data")
       moduleServer(id, function(input, output, session) {
-        datanames_rv <- reactive({
-          .teal_data_ls(req(data()))
-        })
-
+        datanames_rv <- reactive(ls(teal.code::get_env((req(data())))))
         observeEvent(datanames_rv(), {
           selected <- input$dataname
           if (identical(selected, "")) {

R/init.R

@@ -207,16 +207,16 @@ init <- function(data,
 
   ## `data` - `modules`
   if (inherits(data, "teal_data")) {
-    if (length(.teal_data_ls(data)) == 0) {
+    if (length(ls(teal.code::get_env(data))) == 0) {
       stop("The environment of `data` is empty.")
     }
 
-    is_modules_ok <- check_modules_datanames(modules, .teal_data_ls(data))
+    is_modules_ok <- check_modules_datanames(modules, ls(teal.code::get_env(data)))
     if (!isTRUE(is_modules_ok) && length(unlist(extract_transformers(modules))) == 0) {
       lapply(is_modules_ok$string, warning, call. = FALSE)
     }
 
-    is_filter_ok <- check_filter_datanames(filter, .teal_data_ls(data))
+    is_filter_ok <- check_filter_datanames(filter, ls(teal.code::get_env(data)))
     if (!isTRUE(is_filter_ok)) {
       warning(is_filter_ok)
       # we allow app to continue if applied filters are outside

R/module_data_summary.R

@@ -62,8 +62,7 @@ srv_data_summary <- function(id, teal_data) {
 
       summary_table <- reactive({
         req(inherits(teal_data(), "teal_data"))
-
-        if (!length(.teal_data_ls(teal_data()))) {
+        if (!length(ls(teal.code::get_env(teal_data())))) {
           return(NULL)
         }
 
@@ -141,22 +140,18 @@ srv_data_summary <- function(id, teal_data) {
 get_filter_overview <- function(teal_data) {
   datanames <- teal.data::datanames(teal_data())
   joinkeys <- teal.data::join_keys(teal_data())
+
   filtered_data_objs <- sapply(
     datanames,
-    function(name) teal.code::get_env(teal_data())[[name]],
-    simplify = FALSE
-  )
-  unfiltered_data_objs <- sapply(
-    datanames,
-    function(name) teal.code::get_env(teal_data())[[paste0(name, "._raw_")]],
+    function(name) teal.code::get_var(teal_data(), name),
     simplify = FALSE
   )
+  unfiltered_data_objs <- teal.code::get_var(teal_data(), ".raw_data")
 
   rows <- lapply(
     datanames,
     function(dataname) {
       parent <- teal.data::parent(joinkeys, dataname)
-
       # todo: what should we display for a parent dataset?
       #     - Obs and Subjects
       #     - Obs only

R/module_filter_data.R

@@ -52,7 +52,15 @@ srv_filter_data <- function(id, datasets, active_datanames, data_rv, is_active)
 
 #' @rdname module_filter_data
 .make_filtered_teal_data <- function(modules, data, datasets = NULL, datanames) {
-  data <- eval_code(data, sprintf("%1$s._raw_ <- %1$s", datanames))
+  data <- eval_code(
+    data,
+    paste0(
+      ".raw_data <- list2env(list(",
+      toString(sprintf("%1$s = %1$s", datanames)),
+      "))\n",
+      "lockEnvironment(.raw_data) #@linksto .raw_data" # this is environment and it is shared by qenvs. CAN'T MODIFY!
+    )
+  )
   filtered_code <- teal.slice::get_filter_expr(datasets = datasets, datanames = datanames)
   filtered_teal_data <- .append_evaluated_code(data, filtered_code)
   filtered_datasets <- sapply(datanames, function(x) datasets$get_data(x, filtered = TRUE), simplify = FALSE)

R/module_init_data.R

@@ -107,7 +107,7 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
         )
       }
 
-      is_filter_ok <- check_filter_datanames(filter, .teal_data_ls(data_validated()))
+      is_filter_ok <- check_filter_datanames(filter, ls(teal.code::get_env(data_validated())))
       if (!isTRUE(is_filter_ok)) {
         showNotification(
           "Some filters were not applied because of incompatibility with data. Contact app developer.",
@@ -134,7 +134,10 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
     })
 
     # Adds signature protection to the datanames in the data
-    reactive(.add_signature_to_data(data_validated()))
+    reactive({
+      req(data_validated())
+      .add_signature_to_data(data_validated())
+    })
   })
 }
 
@@ -171,7 +174,7 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) {
 #' @return A character vector with the code lines.
 #' @keywords internal
 #'
-.get_hashes_code <- function(data, datanames = .teal_data_ls(data)) {
+.get_hashes_code <- function(data, datanames = ls(teal.code::get_env(data))) {
   vapply(
     datanames,
     function(dataname, datasets) {

R/module_nested_tabs.R

@@ -301,11 +301,11 @@ srv_teal_module.teal_module <- function(id,
 .resolve_module_datanames <- function(data, modules) {
   stopifnot("data_rv must be teal_data object." = inherits(data, "teal_data"))
   if (is.null(modules$datanames) || identical(modules$datanames, "all")) {
-    .teal_data_ls(data)
+    .topologically_sort_datanames(ls(teal.code::get_env(data)), teal.data::join_keys(data))
   } else {
     intersect(
-      include_parent_datanames(modules$datanames, teal.data::join_keys(data)),
-      .teal_data_ls(data)
+      .include_parent_datanames(modules$datanames, teal.data::join_keys(data)),
+      ls(teal.code::get_env(data))
     )
   }
 }

R/module_teal_data.R

@@ -161,7 +161,10 @@ srv_validate_reactive_teal_data <- function(id, # nolint: object_length
 
     output$shiny_warnings <- renderUI({
       if (inherits(data_out_r(), "teal_data")) {
-        is_modules_ok <- check_modules_datanames(modules = modules, datanames = .teal_data_ls(data_validated()))
+        is_modules_ok <- check_modules_datanames(
+          modules = modules,
+          datanames = ls(teal.code::get_env(data_validated()))
+        )
         if (!isTRUE(is_modules_ok)) {
           tags$div(
             is_modules_ok$html(

R/teal_data_utils.R

@@ -33,7 +33,7 @@ NULL
   checkmate::assert_class(data, "teal_data")
   checkmate::assert_class(objects, "list")
   new_env <- list2env(objects, parent = .GlobalEnv)
-  rlang::env_coalesce(new_env, data@env)
+  rlang::env_coalesce(new_env, teal.code::get_env(data))
   data@env <- new_env
   data
 }
@@ -42,35 +42,23 @@ NULL
 .subset_teal_data <- function(data, datanames) {
   checkmate::assert_class(data, "teal_data")
   checkmate::assert_class(datanames, "character")
-  datanames_corrected <- intersect(datanames, ls(data@env))
-  dataname_corrected_with_raw <- intersect(c(datanames, sprintf("%s._raw_", datanames)), ls(data@env))
-
-  if (!length(datanames)) {
+  datanames_corrected <- intersect(datanames, ls(teal.code::get_env(data)))
+  datanames_corrected_with_raw <- c(datanames_corrected, ".raw_data")
+  if (!length(datanames_corrected)) {
     return(teal_data())
   }
 
   new_data <- do.call(
     teal.data::teal_data,
     args = c(
-      mget(x = dataname_corrected_with_raw, envir = data@env),
+      mget(x = datanames_corrected_with_raw, envir = teal.code::get_env(data)),
       list(
-        code = gsub(
-          "warning('Code was not verified for reproducibility.')\n",
-          "",
-          teal.data::get_code(data, datanames = dataname_corrected_with_raw),
-          fixed = TRUE
-        ),
+        code = teal.data::get_code(data, datanames = datanames_corrected_with_raw),
         join_keys = teal.data::join_keys(data)[datanames_corrected]
       )
     )
   )
   new_data@verified <- data@verified
-  teal.data::datanames(new_data) <- datanames
+  teal.data::datanames(new_data) <- datanames_corrected
   new_data
 }
-
-#' @rdname teal_data_utilities
-.teal_data_ls <- function(data) {
-  checkmate::assert_class(data, "teal_data")
-  grep("._raw_", ls(teal.code::get_env(data), all.names = FALSE), value = TRUE, invert = TRUE)
-}

R/utils.R

@@ -44,20 +44,28 @@ get_teal_bs_theme <- function() {
 #' Return parentnames along with datanames.
 #' @noRd
 #' @keywords internal
-include_parent_datanames <- function(dataname, join_keys) {
-  ordered_datanames <- dataname
-  for (i in dataname) {
+.include_parent_datanames <- function(datanames, join_keys) {
+  ordered_datanames <- datanames
+  for (i in datanames) {
     parents <- character(0)
     while (length(i) > 0) {
       parent_i <- teal.data::parent(join_keys, i)
       parents <- c(parent_i, parents)
       i <- parent_i
     }
-    ordered_datanames <- c(parents, dataname, ordered_datanames)
+    ordered_datanames <- c(parents, ordered_datanames)
   }
   unique(ordered_datanames)
 }
 
+#' Return topologicaly sorted datanames
+#' @noRd
+#' @keywords internal
+.topologically_sort_datanames <- function(datanames, join_keys) {
+  datanames_with_parents <- .include_parent_datanames(datanames, join_keys)
+  intersect(datanames, datanames_with_parents)
+}
+
 #' Create a `FilteredData`
 #'
 #' Create a `FilteredData` object from a `teal_data` object.
@@ -66,7 +74,7 @@ include_parent_datanames <- function(dataname, join_keys) {
 #' @param datanames (`character`) vector of data set names to include; must be subset of `datanames(x)`
 #' @return A `FilteredData` object.
 #' @keywords internal
-teal_data_to_filtered_data <- function(x, datanames = .teal_data_ls(x)) {
+teal_data_to_filtered_data <- function(x, datanames = ls(teal.code::get_env(x))) {
   checkmate::assert_class(x, "teal_data")
   checkmate::assert_character(datanames, min.chars = 1L, any.missing = FALSE)
   # Otherwise, FilteredData will be created in the modules' scope later
@@ -79,6 +87,7 @@ teal_data_to_filtered_data <- function(x, datanames = .teal_data_ls(x)) {
   )
 }
 
+
 #' Template function for `TealReportCard` creation and customization
 #'
 #' This function generates a report card with a title,