diff --git a/R/dummy_functions.R b/R/dummy_functions.R index 7e6765dfbc..fd3f067699 100644 --- a/R/dummy_functions.R +++ b/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, "")) { diff --git a/R/init.R b/R/init.R index ca5820e0a0..e6cb66953b 100644 --- a/R/init.R +++ b/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 diff --git a/R/module_data_summary.R b/R/module_data_summary.R index f9c6beaeae..e793c53f70 100644 --- a/R/module_data_summary.R +++ b/R/module_data_summary.R @@ -62,7 +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) } @@ -143,16 +143,15 @@ get_filter_overview <- function(teal_data) { filtered_data_objs <- sapply( datanames, - function(name) teal.code::get_env(teal_data())[[name]], + function(name) teal.code::get_var(teal_data(), name), simplify = FALSE ) - unfiltered_data_objs <- teal.code::get_env(teal_data())[[".raw_data"]] + 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 diff --git a/R/module_init_data.R b/R/module_init_data.R index 824f4bf0cc..e79909a1f9 100644 --- a/R/module_init_data.R +++ b/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.", @@ -154,7 +154,7 @@ srv_init_data <- function(id, data, modules, filter = teal_slices()) { list(code = trimws(c(teal.code::get_code(data), hashes), which = "right")), list(join_keys = teal.data::join_keys(data)), sapply( - .teal_data_ls(data), + ls(teal.code::get_env(data)), teal.code::get_var, object = data, simplify = FALSE @@ -174,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) { diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 7bc3a72fbf..76ead65b33 100644 --- a/R/module_nested_tabs.R +++ b/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)) ) } } diff --git a/R/module_teal_data.R b/R/module_teal_data.R index f1c6087575..943f635136 100644 --- a/R/module_teal_data.R +++ b/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( diff --git a/R/teal_data_utils.R b/R/teal_data_utils.R index 1ecac9c3f6..f02b3d4bcf 100644 --- a/R/teal_data_utils.R +++ b/R/teal_data_utils.R @@ -42,9 +42,9 @@ NULL .subset_teal_data <- function(data, datanames) { checkmate::assert_class(data, "teal_data") checkmate::assert_class(datanames, "character") - datanames_corrected <- intersect(datanames, .teal_data_ls(data)) + datanames_corrected <- intersect(datanames, ls(teal.code::get_env(data))) datanames_corrected_with_raw <- c(datanames_corrected, ".raw_data") - if (!length(datanames)) { + if (!length(datanames_corrected)) { return(teal_data()) } @@ -67,12 +67,3 @@ NULL teal.data::datanames(new_data) <- datanames_corrected new_data } - -#' @rdname teal_data_utilities -.teal_data_ls <- function(data) { - datanames <- ls( - teal.code::get_env(data), - all.names = FALSE # doesn't consider objects prefixed by `.` as datanames (including filtered datanames) - ) - include_parent_datanames(datanames, teal.data::join_keys(data)) # for topological sort -} diff --git a/R/utils.R b/R/utils.R index 36cd81f564..d2bedef4e3 100644 --- a/R/utils.R +++ b/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, diff --git a/man/dot-get_hashes_code.Rd b/man/dot-get_hashes_code.Rd index 07280ef587..2b6d519312 100644 --- a/man/dot-get_hashes_code.Rd +++ b/man/dot-get_hashes_code.Rd @@ -4,7 +4,7 @@ \alias{.get_hashes_code} \title{Get code that tests the integrity of the reproducible data} \usage{ -.get_hashes_code(data, datanames = .teal_data_ls(data)) +.get_hashes_code(data, datanames = ls(teal.code::get_env(data))) } \arguments{ \item{data}{(\code{teal_data}) object holding the data} diff --git a/man/teal_data_to_filtered_data.Rd b/man/teal_data_to_filtered_data.Rd index 4d7d53e38e..d6eecd90cd 100644 --- a/man/teal_data_to_filtered_data.Rd +++ b/man/teal_data_to_filtered_data.Rd @@ -4,7 +4,7 @@ \alias{teal_data_to_filtered_data} \title{Create a \code{FilteredData}} \usage{ -teal_data_to_filtered_data(x, datanames = .teal_data_ls(x)) +teal_data_to_filtered_data(x, datanames = ls(teal.code::get_env(x))) } \arguments{ \item{x}{(\code{teal_data}) object} diff --git a/man/teal_data_utilities.Rd b/man/teal_data_utilities.Rd index a9fc37eb9a..07f850f124 100644 --- a/man/teal_data_utilities.Rd +++ b/man/teal_data_utilities.Rd @@ -5,7 +5,6 @@ \alias{.append_evaluated_code} \alias{.append_modified_data} \alias{.subset_teal_data} -\alias{.teal_data_ls} \title{\code{teal_data} utils} \usage{ .append_evaluated_code(data, code) @@ -13,8 +12,6 @@ .append_modified_data(data, objects) .subset_teal_data(data, datanames) - -.teal_data_ls(data) } \arguments{ \item{data}{(\code{teal_data})}