867 modify mapping matrix (#879)

Fixes #867 
Fixes #878 

The mapping matrix is modified to display filters that cannot be applied
to a particular module as NA.

In `matrix_to_mapping` filters that are NA are treated as TRUE because
global filters may not apply to some modules.

Requires a new public method in `FilteredData`, introduced
[here](insightsengineering/teal.slice#408).

R/module_filter_manager.R

@@ -137,22 +137,29 @@ 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(
       expr = {
         # 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())

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, ]

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