Merge branch 'main' into 211_subset@main

Signed-off-by: Marcin <[email protected]>
insightsengineering · Nov 8, 2024 · 5143912 · 5143912
2 parents e27dad6 + 3e4499e
commit 5143912
Show file tree

Hide file tree

Showing 28 changed files with 74 additions and 97 deletions.
diff --git a/.pre-commit-config.yaml b/.pre-commit-config.yaml
@@ -37,6 +37,9 @@ repos:
           - insightsengineering/teal.slice
           - insightsengineering/teal.widgets
           - utils
+          - shinytest2 # Necessary for documentation
+          - shinyvalidate # Necessary for documentation
+          - rvest # Necessary for documentation
       - id: spell-check
         name: Check spelling with `spelling`
         exclude: >

diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,8 +1,8 @@
 Type: Package
 Package: teal
 Title: Exploratory Web Apps for Analyzing Clinical Trials Data
-Version: 0.15.2.9081
-Date: 2024-11-07
+Version: 0.15.2.9082
+Date: 2024-11-08
 Authors@R: c(
     person("Dawid", "Kaledkowski", , "[email protected]", role = c("aut", "cre"),
            comment = c(ORCID = "0000-0001-9533-457X")),
@@ -37,7 +37,7 @@ BugReports: https://github.com/insightsengineering/teal/issues
 Depends:
     R (>= 4.0),
     shiny (>= 1.8.1),
-    teal.data (>= 0.6.0.9014),
+    teal.data (>= 0.6.0.9015),
     teal.slice (>= 0.5.1.9009)
 Imports:
     checkmate (>= 2.1.0),
@@ -49,7 +49,7 @@ Imports:
     rlang (>= 1.0.0),
     shinyjs,
     stats,
-    teal.code (>= 0.5.0.9011),
+    teal.code (>= 0.5.0.9012),
     teal.logger (>= 0.2.0),
     teal.reporter (>= 0.3.1.9004),
     teal.widgets (>= 0.4.0),

diff --git a/NEWS.md b/NEWS.md
@@ -1,4 +1,4 @@
-# teal 0.15.2.9081
+# teal 0.15.2.9082
 
 ### New features
 

diff --git a/R/dummy_functions.R b/R/dummy_functions.R
@@ -20,7 +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(ls(teal.code::get_env((req(data())))))
+        datanames_rv <- reactive(names(req(data())))
         observeEvent(datanames_rv(), {
           selected <- input$dataname
           if (identical(selected, "")) {

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

diff --git a/R/module_data_summary.R b/R/module_data_summary.R
@@ -64,7 +64,7 @@ srv_data_summary <- function(id, teal_data) {
 
       summary_table <- reactive({
         req(inherits(teal_data(), "teal_data"))
-        if (!length(ls(teal.code::get_env(teal_data())))) {
+        if (!length(teal_data())) {
           return(NULL)
         }
         get_filter_overview_wrapper(teal_data)
@@ -142,7 +142,8 @@ srv_data_summary <- function(id, teal_data) {
 
 #' @rdname module_data_summary
 get_filter_overview_wrapper <- function(teal_data) {
-  datanames <- teal.data::datanames(teal_data())
+  # Sort datanames in topological order
+  datanames <- names(teal_data())
   joinkeys <- teal.data::join_keys(teal_data())
 
   current_data_objs <- sapply(

diff --git a/R/module_init_data.R b/R/module_init_data.R
@@ -101,7 +101,7 @@ srv_init_data <- function(id, data) {
       list(code = trimws(c(teal.code::get_code(data), hashes), which = "right")),
       list(join_keys = teal.data::join_keys(data)),
       sapply(
-        ls(teal.code::get_env(data)),
+        names(data),
         teal.code::get_var,
         object = data,
         simplify = FALSE
@@ -121,7 +121,7 @@ srv_init_data <- function(id, data) {
 #' @return A character vector with the code lines.
 #' @keywords internal
 #'
-.get_hashes_code <- function(data, datanames = ls(teal.code::get_env(data))) {
+.get_hashes_code <- function(data, datanames = names(data)) {
   vapply(
     datanames,
     function(dataname, datasets) {

diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R
@@ -364,11 +364,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")) {
-    .topologically_sort_datanames(ls(teal.code::get_env(data)), teal.data::join_keys(data))
+    names(data)
   } else {
     intersect(
-      .include_parent_datanames(modules$datanames, teal.data::join_keys(data)),
-      ls(teal.code::get_env(data))
+      names(data), # Keep topological order from teal.data::names()
+      .include_parent_datanames(modules$datanames, teal.data::join_keys(data))
     )
   }
 }

diff --git a/R/module_teal.R b/R/module_teal.R
@@ -195,7 +195,7 @@ srv_teal <- function(id, data, modules, filter = teal_slices()) {
     )
     data_rv <- reactive({
       req(inherits(data_validated(), "teal_data"))
-      is_filter_ok <- check_filter_datanames(filter, ls(teal.code::get_env(data_validated())))
+      is_filter_ok <- check_filter_datanames(filter, names(data_validated()))
       if (!isTRUE(is_filter_ok)) {
         showNotification(
           "Some filters were not applied because of incompatibility with data. Contact app developer.",

diff --git a/R/module_teal_data.R b/R/module_teal_data.R
@@ -223,7 +223,7 @@ srv_check_shiny_warnings <- function(id, data, modules) {
     output$message <- renderUI({
       if (inherits(data(), "teal_data")) {
         is_modules_ok <- check_modules_datanames_html(
-          modules = modules, datanames = ls(teal.code::get_env(data()))
+          modules = modules, datanames = names(data())
         )
         if (!isTRUE(is_modules_ok)) {
           tags$div(is_modules_ok, class = "teal-output-warning")

diff --git a/R/teal_data_module.R b/R/teal_data_module.R
@@ -48,7 +48,6 @@
 #'             dataset2 <- mtcars
 #'           }
 #'         )
-#'         datanames(data) <- c("dataset1", "dataset2")
 #'
 #'         data
 #'       })

diff --git a/R/teal_data_utils.R b/R/teal_data_utils.R
@@ -9,8 +9,8 @@
 #' `teal.code` and `teal.data` methods.
 #'
 #' @param data (`teal_data`)
-#' @param code (`character`) code to append to `data@code`
-#' @param objects (`list`) objects to append to `data@env`
+#' @param code (`character`) code to append to the object's code slot.
+#' @param objects (`list`) objects to append to object's environment.
 #' @param datanames (`character`) names of the datasets
 #' @return modified `teal_data`
 #' @keywords internal
@@ -30,7 +30,7 @@ NULL
   checkmate::assert_class(data, "teal_data")
   checkmate::assert_class(objects, "list")
   new_env <- list2env(objects, parent = .GlobalEnv)
-  rlang::env_coalesce(new_env, teal.code::get_env(data))
-  data@env <- new_env
+  rlang::env_coalesce(new_env, as.environment(data))
+  data@.xData <- new_env
   data
 }
diff --git a/R/utils.R b/R/utils.R
@@ -46,43 +46,32 @@ get_teal_bs_theme <- function() {
 #' @keywords internal
 .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
+  for (current in datanames) {
+    parents <- character(0L)
+    while (length(current) > 0) {
+      current <- teal.data::parent(join_keys, current)
+      parents <- c(current, parents)
     }
     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)
+  unique(ordered_datanames)
 }
 
 #' Create a `FilteredData`
 #'
 #' Create a `FilteredData` object from a `teal_data` object.
 #'
 #' @param x (`teal_data`) object
-#' @param datanames (`character`) vector of data set names to include; must be subset of `datanames(x)`
+#' @param datanames (`character`) vector of data set names to include; must be subset of `names(x)`
 #' @return A `FilteredData` object.
 #' @keywords internal
-teal_data_to_filtered_data <- function(x, datanames = ls(teal.code::get_env(x))) {
+teal_data_to_filtered_data <- function(x, datanames = names(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
   teal.slice::init_filtered_data(
-    x = Filter(
-      length,
-      sapply(datanames, function(dn) x[[dn]], simplify = FALSE)
-    ),
+    x = Filter(length, sapply(datanames, function(dn) x[[dn]], simplify = FALSE)),
     join_keys = teal.data::join_keys(x)
   )
 }
@@ -328,7 +317,7 @@ create_app_id <- function(data, modules) {
   checkmate::assert_class(modules, "teal_modules")
 
   data <- if (inherits(data, "teal_data")) {
-    as.list(teal.code::get_env(data))
+    as.list(data)
   } else if (inherits(data, "teal_data_module")) {
     deparse1(body(data$server))
   }

diff --git a/man/dot-get_hashes_code.Rd b/man/dot-get_hashes_code.Rd
diff --git a/man/teal_data_module.Rd b/man/teal_data_module.Rd
diff --git a/man/teal_data_to_filtered_data.Rd b/man/teal_data_to_filtered_data.Rd
diff --git a/man/teal_data_utilities.Rd b/man/teal_data_utilities.Rd
diff --git a/tests/testthat/helper-shinytest2.R b/tests/testthat/helper-shinytest2.R
@@ -3,7 +3,6 @@ simple_teal_data <- function() {
     iris <- iris
     mtcars <- mtcars
   })
-  datanames(data) <- c("iris", "mtcars")
   data
 }
 
@@ -17,7 +16,7 @@ report_module <- function(label = "example teal module") {
           reporter = reporter,
           card_fun = function(card) card
         )
-        updateSelectInput(session, "dataname", choices = isolate(datanames(data())))
+        updateSelectInput(session, "dataname", choices = isolate(names(data())))
         output$dataset <- renderPrint({
           req(input$dataname)
           data()[[input$dataname]]
-Original file line number
+Diff line change
@@ Expand Up / @@ -48,7 +48,6 @@ @@
     #'             dataset2 <- mtcars
     #'           }
     #'         )
-    #'         datanames(data) <- c("dataset1", "dataset2")
     #'
     #'         data
     #'       })
@@ Expand Down @@