Skip to content

Commit

Permalink
298 reset button (#859)
Browse files Browse the repository at this point in the history 
Relates to [this
issue](insightsengineering/teal.slice#298).

Adds module for management of snapshots of application state.
A snapshot contains in formation on all filter states currently existing
within the app, as well as their application to particular modules.
A snapshot can be added at any time by the user.
A snapshot can be restored at any time by the user.
A snapshot can be saved to file.
The initial state of the application is the first snapshot (not
displayed in the list).

In addition, `teal_slices` handles global-module-specific specification
differently. The deciding argument is `module_specific`.
`mapping$global_filters` will decide which - if any - filters are active
on start-up in global mode.

---------

Signed-off-by: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com>
Co-authored-by: go_gonzo <dawid.kaledkowski@gmail.com>
Co-authored-by: Andrew Bates <andrew.bates@atorusresearch.com>
Co-authored-by: asbates <asbates@users.noreply.github.com>
Co-authored-by: chlebowa <chlebowa@users.noreply.github.com>
Co-authored-by: 27856297+dependabot-preview[bot]@users.noreply.github.com <27856297+dependabot-preview[bot]@users.noreply.github.com>
Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com>
Co-authored-by: Marcin <133694481+m7pr@users.noreply.github.com>
Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com>
Co-authored-by: kartikeya kirar <kirar.kartikeya1@gmail.com>
Co-authored-by: kartikeya <kartikeya.kirar@unicle.life>
  • Loading branch information
@chlebowa @gogonzo
@asbates @dependabot-preview @m7pr @github-actions @kartikeyakirar
11 people committed Jul 21, 2023
1 parent bc37145 commit f88693f
Show file tree
Hide file tree
Showing 29 changed files with 904 additions and 316 deletions.
1 change: 1 addition & 0 deletions DESCRIPTION
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,6 +83,7 @@ Collate:
'init.R'
'module_filter_manager.R'
'module_nested_tabs.R'
'module_snapshot_manager.R'
'module_tabs_with_filters.R'
'module_teal.R'
'module_teal_with_splash.R'
Expand Down
1 change: 1 addition & 0 deletions NEWS.md
View file
Original file line number Diff line number Diff line change
Expand Up @@ -3,6 +3,7 @@
### New features

* Enabled module specific filter panel. See `module_specific` in `teal::teal_slices` documentation.
* Enabled capturing and resetting application filter state with snapshots. See `?snapshot`.
* Enabled `reporter_previewer_module` to customize default values through `srv_args`.
* Enabled passing own `reporter_previewer_module` in a list of modules to override default one.

Expand Down
179 changes: 88 additions & 91 deletions R/module_filter_manager.R
View file
Original file line number Diff line number Diff line change
@@ -1,6 +1,7 @@
#' Filter manager modal
#'
#' Filter manager modal
#' Opens modal containing the filter manager UI.
#'
#' @name module_filter_manager_modal
#' @inheritParams filter_manager_srv
#' @examples
Expand Down Expand Up @@ -38,6 +39,7 @@
#' if (interactive()) {
#' runApp(app)
#' }
#'
#' @keywords internal
#'
NULL
Expand All @@ -62,6 +64,7 @@ filter_manager_modal_srv <- function(id, filtered_data_list, filter) {
modalDialog(
filter_manager_ui(session$ns("filter_manager")),
size = "l",
footer = NULL,
easyClose = TRUE
)
)
Expand All @@ -75,145 +78,153 @@ filter_manager_modal_srv <- function(id, filtered_data_list, filter) {
filter_manager_ui <- function(id) {
ns <- NS(id)
div(
tableOutput(ns("slices_table"))
class = "filter_manager_content",
tableOutput(ns("slices_table")),
snapshot_manager_ui(ns("snapshot_manager"))
)
}

#' Manage multiple `FilteredData` objects
#'
#' Manage multiple `FilteredData` objects
#' Oversee filter states in the whole application.
#'
#' @rdname module_filter_manager
#' @details
#' This module observes the changes of the filters in each `FilteredData` object
#' and keeps track of all filters used. Map of the filters is kept in so called
#' `slices_map` object where each `FilteredData` is linked with its active filters.
#' This map is represented in the UI as a matrix where rows are ids of the filters and
#' columns are names of the `filtered_data_list` (named after teal modules).
#' and keeps track of all filters used. A mapping of filters to modules
#' is kept in the `mapping_matrix` object (which is actually a `data.frame`)
#' that tracks which filters (rows) are active in which modules (columns).
#'
#' @param id (`character(1)`)\cr
#' `shiny` module id.
#' @param filtered_data_list (`list` of `FilteredData`)\cr
#' Names of the list should be the same as `teal_module$label`.
#' @param filtered_data_list (`named list`)\cr
#' A list, possibly nested, of `FilteredData` objects.
#' Each `FilteredData` will be served to one module in the `teal` application.
#' The structure of the list must reflect the nesting of modules in tabs
#' and names of the list must be the same as labels of their respective modules.
#' @inheritParams init
#' @return A list of `reactive`s, each holding a `teal_slices`, as returned by `filter_manager_module_srv`.
#' @keywords internal
#'
filter_manager_srv <- function(id, filtered_data_list, filter) {
moduleServer(id, function(input, output, session) {
logger::log_trace("filter_manager_srv initializing for: { paste(names(filtered_data_list), collapse = ', ')}.")

# instead of unlist which unlist with concatenating nested names with '.'
flatten_nested <- function(x, name = NULL) {
if (inherits(x, "FilteredData")) {
setNames(list(x), name)
} else {
unlist(lapply(names(x), function(name) flatten_nested(x[[name]], name)))
}
}
filtered_data_list <- flatten_nested(filtered_data_list)
is_module_specific <- isTRUE(attr(filter, "module_specific"))

# global list of slices (all available teal_slice)
# Create global list of slices.
# Contains all available teal_slice objects available to all modules.
# Passed whole to instances of FilteredData used for individual modules.
# Down there a subset that pertains to the data sets used in that module is applied and displayed.
slices_global <- reactiveVal(filter)

# create a reactive map between modules and filters
slices_map <- sapply(
names(filtered_data_list),
function(module_name) {
shiny::reactiveVal(
unlist(attr(filter, "mapping")[c(module_name, "global_filters")], use.names = FALSE)
)
filtered_data_list <-
if (!is_module_specific) {
# Retrieve the first FilteredData from potentially nested list.
# List of length one is named "global_filters" because that name is forbidden for a module label.
list(global_filters = filtered_data_list[[1]])
} else {
# Flatten potentially nested list of FilteredData objects while maintaining useful names.
# Simply using `unlist` would result in concatenated names.
flatten_nested <- function(x, name = NULL) {
if (inherits(x, "FilteredData")) {
setNames(list(x), name)
} else {
unlist(lapply(names(x), function(name) flatten_nested(x[[name]], name)))
}
}
flatten_nested(filtered_data_list)
}

# Create mapping fo filters to modules in matrix form (presented as data.frame).
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)
})

output$slices_table <- renderTable(
expr = {
# Display logical values as UTF characters.
mm <- mapping_matrix()
mm[] <- lapply(mm, ifelse, yes = intToUtf8(9989), no = intToUtf8(10060))
if (!is_module_specific) colnames(mm) <- "Global Filters"
mm
},
align = paste(c("l", rep("c", ncol(mapping_matrix()))), collapse = ""),
rownames = TRUE
)

# Create list of module calls.
modules_out <- lapply(names(filtered_data_list), function(module_name) {
filter_manager_module_srv(
id = module_name,
module_fd = filtered_data_list[[module_name]],
slices_map_module = slices_map[[module_name]],
slices_global = slices_global
)
})

mapping_matrix <- reactive({
module_names <- names(filtered_data_list)
filter_names <- vapply(X = slices_global(), `[[`, character(1), "id")
mapping_matrix <- matrix(
FALSE,
nrow = length(filter_names),
ncol = length(module_names),
dimnames = list(filter_names, module_names)
)
for (i in module_names) {
mapping_matrix[slices_map[[i]](), i] <- TRUE
}
mapping_matrix
})

output$slices_table <- renderTable(rownames = TRUE, {
as.data.frame(mapping_matrix())
})
# Call snapshot manager.
snapshot_manager_srv("snapshot_manager", slices_global, mapping_matrix, filtered_data_list)

modules_out # returned for testing purpose
})
}

#' Module specific filter manager
#'
#' This module compares filters between single `FilteredData` settings
#' and global `teal_slices`. Updates appropriate objects `module_fd`,
#' `slices_map_module`, `slices_global` to keep them consistent.
#' Track filter states in single module.
#'
#' This module tracks the state of a single `FilteredData` object and global `teal_slices`
#' and updates both objects as necessary. Filter states added in different modules
#' Filter states added any individual module are added to global `teal_slices`
#' and from there become available in other modules
#' by setting `private$available_teal_slices` in each `FilteredData`.
#'
#' @param id (`character(1)`)\cr
#' `shiny` module id.
#' @param module_fd (`FilteredData`)\cr
#' object to filter data in the teal-module
#' @param slices_map_module (`reactiveVal` of `character`)\cr
#' `id` of the `teal_slice` objects used in the module specific `FilteredData`.
#' @param slices_global (`reactiveVal` or `teal_slices`)\cr
#' stores a list of all available filters which can be utilized in several ways, for example:
#' - to disable/enable specific filter in the module
#' - to restore filter saved settings
#' - to save current filter settings panel
#' @return shiny module returning NULL
#' @param slices_global (`reactiveVal`)\cr
#' stores `teal_slices` with all available filters; allows the following actions:
#' - to disable/enable a specific filter in a module
#' - to restore saved filter settings
#' - to save current filter panel settings
#' @return A `reactive` expression containing the slices active in this module.
#' @keywords internal
filter_manager_module_srv <- function(id, module_fd, slices_map_module, slices_global) {
#'
filter_manager_module_srv <- function(id, module_fd, slices_global) {
moduleServer(id, function(input, output, session) {
setdiff_teal_slices <- function(x, y) {
Filter(
function(xx) {
!any(vapply(y, function(yy) identical(yy, xx), logical(1)))
},
x
)
}

available_slices <- reactive(
# 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)

# Track filter state of this module.
slices_module <- reactive(module_fd$get_filter_state())

previous_slices <- reactiveVal(shiny::isolate(slices_module()))
# Reactive values for comparing states.
previous_slices <- reactiveVal(isolate(slices_module()))
slices_added <- reactiveVal(NULL)
slices_activated <- reactiveVal(NULL)
slices_deactivated <- reactiveVal(NULL)

observeEvent(slices_module(), {
# Observe changes in module filter state and trigger appropriate actions.
observeEvent(slices_module(), ignoreNULL = FALSE, {
logger::log_trace("filter_manager_srv@1 detecting states deltas in module: { id }.")
added <- setdiff_teal_slices(slices_module(), slices_global())
activated <- setdiff_teal_slices(slices_module(), previous_slices())
deactivated <- setdiff_teal_slices(previous_slices(), slices_module())
if (length(added)) slices_added(added)
if (length(activated)) slices_activated(activated)
if (length(deactivated)) slices_deactivated(deactivated)
previous_slices(slices_module())
})

observeEvent(slices_added(), ignoreNULL = TRUE, {
logger::log_trace("filter_manager_srv@2 added filter in module: { id }.")
# In case the new state has the same id as an existing state, add a suffix to it.
global_ids <- vapply(slices_global(), `[[`, character(1L), "id")
lapply(
slices_added(),
function(slice) {
global_ids <- vapply(slices_global(), function(x) x$id, character(1))
if (slice$id %in% global_ids) {
slice$id <- utils::tail(make.unique(c(global_ids, slice$id), sep = "_"), 1)
}
Expand All @@ -224,20 +235,6 @@ filter_manager_module_srv <- function(id, module_fd, slices_map_module, slices_g
slices_added(NULL)
})

observeEvent(slices_activated(), ignoreNULL = TRUE, {
logger::log_trace("filter_manager_srv@3 activated filter in module: { id }.")
activated_ids <- vapply(slices_activated(), `[[`, character(1), "id")
slices_map_module(c(slices_map_module(), activated_ids))
slices_activated(NULL)
})

observeEvent(slices_deactivated(), ignoreNULL = TRUE, {
logger::log_trace("filter_manager_srv@4 deactivated filter in module: { id }.")
deactivated_ids <- vapply(slices_deactivated(), `[[`, character(1), "id")
slices_map_module(setdiff(slices_map_module(), deactivated_ids))
slices_deactivated(NULL)
})

slices_module # returned for testing purpose
})
}
4 changes: 2 additions & 2 deletions R/module_nested_tabs.R
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,8 +13,8 @@
#' @param depth (`integer(1)`)\cr
#' number which helps to determine depth of the modules nesting.
#' @param is_module_specific (`logical(1)`)\cr
#' flag determining if the filter panel is global or module-specific. When `module_specific`
#' is `TRUE` then a filter panel is called inside of each module tab.
#' flag determining if the filter panel is global or module-specific.
#' When set to `TRUE`, a filter panel is called inside of each module tab.
#' @return depending on class of `modules`:
#' - `teal_module`: instantiated UI of the module
#' - `teal_modules`: `tabsetPanel` with each tab corresponding to recursively
Expand Down

0 comments on commit f88693f

Please sign in to comment.