diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index c044237c5b..03701b6175 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -137,12 +137,17 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { } # Create mapping fo filters to modules in matrix form (presented as data.frame). + # Modules get NAs for filteres that cannot be set for them. mapping_matrix <- reactive({ - module_states <- lapply(filtered_data_list, function(x) x$get_filter_state()) - mapping_ragged <- lapply(module_states, function(x) vapply(x, `[[`, character(1L), "id")) - all_names <- vapply(slices_global(), `[[`, character(1L), "id") - mapping_smooth <- lapply(mapping_ragged, is.element, el = all_names) - as.data.frame(mapping_smooth, row.names = all_names, check.names = FALSE) + state_ids_global <- vapply(slices_global(), `[[`, character(1L), "id") + mapping_smooth <- lapply(filtered_data_list, function(x) { + state_ids_local <- vapply(x$get_filter_state(), `[[`, character(1L), "id") + state_ids_allowed <- vapply(x$get_available_teal_slices()(), `[[`, character(1L), "id") + states_active <- state_ids_global %in% state_ids_local + ifelse(state_ids_global %in% state_ids_allowed, states_active, NA) + }) + + as.data.frame(mapping_smooth, row.names = state_ids_global, check.names = FALSE) }) output$slices_table <- renderTable( @@ -150,9 +155,11 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { # Display logical values as UTF characters. mm <- mapping_matrix() mm[] <- lapply(mm, ifelse, yes = intToUtf8(9989), no = intToUtf8(10060)) + mm[] <- lapply(mm, function(x) ifelse(is.na(x), intToUtf8(128306), x)) if (!is_module_specific) colnames(mm) <- "Global Filters" mm }, + align = paste(c("l", rep("c", length(filtered_data_list))), collapse = ""), rownames = TRUE ) @@ -197,10 +204,7 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { filter_manager_module_srv <- function(id, module_fd, slices_global) { moduleServer(id, function(input, output, session) { # Only operate on slices that refer to data sets present in this module. - available_slices <- reactive({ - Filter(function(slice) slice$dataname %in% module_fd$datanames(), slices_global()) - }) - module_fd$set_available_teal_slices(available_slices) + module_fd$set_available_teal_slices(reactive(slices_global())) # Track filter state of this module. slices_module <- reactive(module_fd$get_filter_state()) diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R index b653c6b3ce..72da2e18fd 100644 --- a/R/module_snapshot_manager.R +++ b/R/module_snapshot_manager.R @@ -264,6 +264,7 @@ unfold_mapping <- function(mapping, module_names) { #' @keywords internal #' matrix_to_mapping <- function(mapping_matrix) { + mapping_matrix[] <- lapply(mapping_matrix, function(x) x | is.na(x)) global <- vapply(as.data.frame(t(mapping_matrix)), all, logical(1L)) global_filters <- names(global[global]) local_filters <- mapping_matrix[!rownames(mapping_matrix) %in% global_filters, ] diff --git a/vignettes/adding-support-for-reporting.Rmd b/vignettes/adding-support-for-reporting.Rmd index e256d0818f..cb936d1040 100644 --- a/vignettes/adding-support-for-reporting.Rmd +++ b/vignettes/adding-support-for-reporting.Rmd @@ -22,7 +22,7 @@ The responsibilities of a module developer include: - Adding support for reporting to their module. - Specifying the outputs that constitute a snapshot of their module. -The entire lifecycle of objects involved in creating the report and configuring the module to preview the report is handled by `teal`. +The entire life cycle of objects involved in creating the report and configuring the module to preview the report is handled by `teal`. ## Custom module