From f88693f7de7dcdb791ae27920062cede485942ff Mon Sep 17 00:00:00 2001 From: Aleksander Chlebowski <114988527+chlebowa@users.noreply.github.com> Date: Fri, 21 Jul 2023 10:25:41 +0200 Subject: [PATCH] 298 reset button (#859) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit Relates to [this issue](https://github.com/insightsengineering/teal.slice/issues/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 Co-authored-by: Andrew Bates Co-authored-by: asbates Co-authored-by: chlebowa 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 Co-authored-by: kartikeya --- DESCRIPTION | 1 + NEWS.md | 1 + R/module_filter_manager.R | 179 +++++------ R/module_nested_tabs.R | 4 +- R/module_snapshot_manager.R | 301 ++++++++++++++++++ R/module_tabs_with_filters.R | 19 +- R/module_teal.R | 4 +- R/teal_reporter.R | 2 +- R/teal_slices.R | 69 ++-- R/zzz.R | 5 +- inst/css/sidebar.css | 36 ++- inst/js/sidebar.js | 1 + man/TealSlicesBlock.Rd | 2 +- man/disassemble_slices.Rd | 21 ++ man/filter_manager_module_srv.Rd | 28 +- man/matrix_to_mapping.Rd | 22 ++ man/module_filter_manager.Rd | 19 +- man/module_filter_manager_modal.Rd | 10 +- man/reassemble_slices.Rd | 18 ++ man/snapshot_manager_module.Rd | 88 +++++ man/teal_slices.Rd | 19 +- man/ui_nested_tabs.Rd | 4 +- man/unfold_mapping.Rd | 20 ++ tests/testthat/test-filter_manager.R | 49 +-- tests/testthat/test-init.R | 45 --- .../testthat/test-module_tabs_with_filters.R | 4 +- tests/testthat/test-modules.R | 64 ---- tests/testthat/test-snapshot_manager.R | 46 +++ tests/testthat/test-teal_slices.R | 139 +++++++- 29 files changed, 904 insertions(+), 316 deletions(-) create mode 100644 R/module_snapshot_manager.R create mode 100644 man/disassemble_slices.Rd create mode 100644 man/matrix_to_mapping.Rd create mode 100644 man/reassemble_slices.Rd create mode 100644 man/snapshot_manager_module.Rd create mode 100644 man/unfold_mapping.Rd create mode 100644 tests/testthat/test-snapshot_manager.R diff --git a/DESCRIPTION b/DESCRIPTION index 41e47f309b..3715568600 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -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' diff --git a/NEWS.md b/NEWS.md index 6ae2c457c4..6f903728cf 100644 --- a/NEWS.md +++ b/NEWS.md @@ -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. diff --git a/R/module_filter_manager.R b/R/module_filter_manager.R index 369ca08365..6186aa93f1 100644 --- a/R/module_filter_manager.R +++ b/R/module_filter_manager.R @@ -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 @@ -38,6 +39,7 @@ #' if (interactive()) { #' runApp(app) #' } +#' #' @keywords internal #' NULL @@ -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 ) ) @@ -75,82 +78,96 @@ 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 }) @@ -158,62 +175,56 @@ filter_manager_srv <- function(id, filtered_data_list, filter) { #' 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) } @@ -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 }) } diff --git a/R/module_nested_tabs.R b/R/module_nested_tabs.R index 2da37b4242..fcdaa4cabc 100644 --- a/R/module_nested_tabs.R +++ b/R/module_nested_tabs.R @@ -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 diff --git a/R/module_snapshot_manager.R b/R/module_snapshot_manager.R new file mode 100644 index 0000000000..4862ef565a --- /dev/null +++ b/R/module_snapshot_manager.R @@ -0,0 +1,301 @@ +#' Filter state snapshot management. +#' +#' Capture and restore snapshots of the global (app) filter state. +#' +#' This module introduces snapshots: stored descriptions of the filter state of the entire application. +#' Snapshots allow the user to save the current filter state of the application for later use in the session, +#' as well as to save it to file in order to share it with an app developer or other users. +#' +#' The snapshot manager is accessed through the filter manager, with the cog icon in the top right corner. +#' At the beginning of a session it presents two icons: a camera and an circular arrow. +#' Clicking the camera captures a snapshot and clicking the arrow resets initial application state. +#' As snapshots are added, they will show up as rows in a table and each will have a select button and a save button. +#' +#' @section Server logic: +#' Snapshots are basically `teal_slices` objects, however, since each module is served by a separate instance +#' of `FilteredData` and these objects require shared state, `teal_slice` is a `reactiveVal` so `teal_slices` +#' cannot be stored as is. Therefore, `teal_slices` are reversibly converted to a list of lists representation +#' (attributes are maintained). +#' +#' Snapshots are stored in a `reactiveVal` as a named list. +#' The first snapshot is the initial state of the application and the user can add a snapshot whenever they see fit. +#' +#' For every snapshot except the initial one, a piece of UI is generated that contains +#' the snapshot name, a select button to restore that snapshot, and a save button to save it to a file. +#' The initial snapshot is restored by a separate "reset" button. +#' It cannot be saved directly but a user is welcome to capture the initial state as a snapshot and save that. +#' +#' @section Snapshot mechanics: +#' When a snapshot is captured, the user is prompted to name it. +#' Names are displayed as is but since they are used to create button ids, +#' under the hood they are converted to syntactically valid strings. +#' New snapshot names are validated so that their valid versions are unique. +#' Leading and trailing white space is trimmed. +#' +#' The module can read the global state of the application from `slices_global` and `mapping_matrix`. +#' The former provides a list of all existing `teal_slice`s and the latter says which slice is active in which module. +#' Once a name has been accepted, `slices_global` is converted to a list of lists - a snapshot. +#' The snapshot contains the `mapping` attribute of the initial application state +#' (or one that has been restored), which may not reflect the current one, +#' so `mapping_matrix` is transformed to obtain the current mapping, i.e. a list that, +#' when passed to the `mapping` argument of [`teal::teal_slices`], would result in the current mapping. +#' This is substituted as the snapshot's `mapping` attribute and the snapshot is added to the snapshot list. +#' +#' To restore app state, a snapshot is retrieved from storage and rebuilt into a `teal_slices` object. +#' Then state of all `FilteredData` objects (provided in `filtered_data_list`) is cleared +#' and set anew according to the `mapping` attribute of the snapshot. +#' The snapshot is then set as the current content of `slices_global`. +#' +#' To save a snapshot, the snapshot is retrieved and reassembled just like for restoring, +#' and then saved to file with [`teal.slice::slices_store`]. +#' +#' @param id (`character(1)`) `shiny` module id +#' @param slices_global (`reactiveVal`) that contains a `teal_slices` object +#' containing all `teal_slice`s existing in the app, both active and inactive +#' @param mapping_matrix (`reactive`) that contains a `data.frame` representation +#' of the mapping of filter state ids (rows) to modules labels (columns); +#' all columns are `logical` vectors +#' @param filtered_data_list non-nested (`named list`) that contains `FilteredData` objects +#' +#' @return Nothing is returned. +#' +#' @name snapshot_manager_module +#' @aliases snapshot snapshot_manager +#' +#' @author Aleksander Chlebowski +#' +#' @rdname snapshot_manager_module +#' @keywords internal +#' +snapshot_manager_ui <- function(id) { + ns <- NS(id) + div( + class = "snapshot_manager_content", + div( + class = "snapshot_table_row", + span(tags$b("Snapshot manager")), + actionLink(ns("snapshot_add"), label = NULL, icon = icon("camera"), title = "add snapshot"), + actionLink(ns("snapshot_reset"), label = NULL, icon = icon("undo"), title = "reset initial state"), + NULL + ), + uiOutput(ns("snapshot_list")) + ) +} + +#' @rdname snapshot_manager_module +#' @keywords internal +#' +snapshot_manager_srv <- function(id, slices_global, mapping_matrix, filtered_data_list) { + checkmate::assert_character(id) + checkmate::assert_true(is.reactive(slices_global)) + checkmate::assert_class(slices_global(), "teal_slices") + checkmate::assert_true(is.reactive(mapping_matrix)) + checkmate::assert_data_frame(mapping_matrix(), null.ok = TRUE) + checkmate::assert_list(filtered_data_list, types = "FilteredData", any.missing = FALSE, names = "named") + + moduleServer(id, function(input, output, session) { + ns <- session$ns + + # Store global filter states. + filter <- isolate(slices_global()) + snapshot_history <- reactiveVal({ + list( + "Initial application state" = disassemble_slices(filter) + ) + }) + + # Snapshot current application state - name snaphsot. + observeEvent(input$snapshot_add, { + showModal( + modalDialog( + textInput(ns("snapshot_name"), "Name the snapshot", width = "100%", placeholder = "Meaningful, unique name"), + footer = tagList( + actionButton(ns("snapshot_name_accept"), "Accept", icon = icon("thumbs-up")), + modalButton(label = "Cancel", icon = icon("thumbs-down")) + ), + size = "s" + ) + ) + }) + # Snapshot current application state - store snaphsot. + observeEvent(input$snapshot_name_accept, { + snapshot_name <- trimws(input$snapshot_name) + if (identical(snapshot_name, "")) { + showNotification( + "Please name the snapshot.", + type = "message" + ) + updateTextInput(inputId = "snapshot_name", value = "", placeholder = "Meaningful, unique name") + } else if (is.element(make.names(snapshot_name), make.names(names(snapshot_history())))) { + showNotification( + "This name is in conflict with other snapshot names. Please choose a different one.", + type = "message" + ) + updateTextInput(inputId = "snapshot_name", value = , placeholder = "Meaningful, unique name") + } else { + snapshot <- disassemble_slices(slices_global()) + attr(snapshot, "mapping") <- matrix_to_mapping(mapping_matrix()) + snapshot_update <- c(snapshot_history(), list(snapshot)) + names(snapshot_update)[length(snapshot_update)] <- snapshot_name + snapshot_history(snapshot_update) + removeModal() + # Reopen filter manager modal by clicking button in the main application. + shinyjs::click(id = "teal-main_ui-filter_manager-show", asis = TRUE) + } + }) + + # Restore initial state. + observeEvent(input$snapshot_reset, { + s <- "Initial application state" + ### Begin restore procedure. ### + snapshot <- snapshot_history()[[s]] + snapshot_state <- reassemble_slices(snapshot) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapply( + function(filtered_data, filters) { + filtered_data$clear_filter_states(force = TRUE) + slices <- Filter(function(x) x$id %in% filters, snapshot_state) + filtered_data$set_filter_state(slices) + }, + filtered_data = filtered_data_list, + filters = mapping_unfolded + ) + slices_global(snapshot_state) + removeModal() + ### End restore procedure. ### + }) + + # Create UI elements and server logic for the snapshot table. + # Observers must be tracked to avoid duplication and excess reactivity. + # Remaining elements are tracked likewise for consistency and a slight speed margin. + observers <- reactiveValues() + handlers <- reactiveValues() + divs <- reactiveValues() + + observeEvent(snapshot_history(), { + lapply(names(snapshot_history())[-1L], function(s) { + id_pickme <- sprintf("pickme_%s", make.names(s)) + id_saveme <- sprintf("saveme_%s", make.names(s)) + id_rowme <- sprintf("rowme_%s", make.names(s)) + + # Observer for restoring snapshot. + if (!is.element(id_pickme, names(observers))) { + observers[[id_pickme]] <- observeEvent(input[[id_pickme]], { + ### Begin restore procedure. ### + snapshot <- snapshot_history()[[s]] + snapshot_state <- reassemble_slices(snapshot) + mapping_unfolded <- unfold_mapping(attr(snapshot_state, "mapping"), names(filtered_data_list)) + mapply( + function(filtered_data, filters) { + filtered_data$clear_filter_states(force = TRUE) + slices <- Filter(function(x) x$id %in% filters, snapshot_state) + filtered_data$set_filter_state(slices) + }, + filtered_data = filtered_data_list, + filters = mapping_unfolded + ) + slices_global(snapshot_state) + removeModal() + ### End restore procedure. ### + }) + } + # Create handler for downloading snapshot. + if (!is.element(id_saveme, names(handlers))) { + output[[id_saveme]] <- downloadHandler( + filename = function() { + sprintf("teal_snapshot_%s_%s.json", s, Sys.Date()) + }, + content = function(file) { + snapshot <- snapshot_history()[[s]] + snapshot_state <- reassemble_slices(snapshot) + teal.slice::slices_store(tss = snapshot_state, file = file) + } + ) + handlers[[id_saveme]] <- id_saveme + } + # Create a row for the snapshot table. + if (!is.element(id_rowme, names(divs))) { + divs[[id_rowme]] <- div( + class = "snapshot_table_row", + span(h5(s)), + actionLink(inputId = ns(id_pickme), label = icon("circle-check"), title = "select"), + downloadLink(outputId = ns(id_saveme), label = icon("save"), title = "save to file") + ) + } + }) + }) + + # Create table to display list of snapshots and their actions. + output$snapshot_list <- renderUI({ + lapply(rev(reactiveValuesToList(divs)), function(d) d) + }) + }) +} + + + + +### utility functions ---- + +#' Convert teal_slices and to list of lists (drop classes), while maintaining attributes. +#' Adds special class so that the reverse action can have assertion on argument type. +#' @param tss (`teal_slices`) +#' @return Object of class `teal_slices_snapshot`, which is a list of the same length as `tss`, +#' where each `teal_slice` has been converted to a list. +#' @keywords internal +#' +disassemble_slices <- function(tss) { + checkmate::assert_class(tss, "teal_slices") + ans <- unclass(tss) + ans[] <- lapply(ans, as.list) + class(ans) <- "teal_slices_snapshot" + ans +} + +#' Rebuild `teal_slices` from `teal_slices_snapshot`. +#' @param x (`teal_slices_snapshot`) +#' @return A `teal_slices` object. +#' @keywords internal +#' +reassemble_slices <- function(x) { + checkmate::assert_class(x, "teal_slices_snapshot") + attrs <- attributes(unclass(x)) + ans <- lapply(x, as.teal_slice) + do.call(teal_slices, c(ans, attrs)) +} + + +#' Explicitly enumerate global filters. +#' +#' Transform module mapping such that global filters are explicitly specified for every module. +#' +#' @param mapping (`named list`) as stored in mapping parameter of `teal_slices` +#' @param module_names (`character`) vector containing names of all modules in the app +#' @return A `named_list` with one element per module, each element containing all filters applied to that module. +#' @keywords internal +#' +unfold_mapping <- function(mapping, module_names) { + module_names <- structure(module_names, names = module_names) + lapply(module_names, function(x) c(mapping[[x]], mapping[["global_filters"]])) +} + +#' Convert mapping matrix to filter mapping specification. +#' +#' Transform a mapping matrix, i.e. a data frame that maps each filter state to each module, +#' to a list specification like the one used in the `mapping` attribute of `teal_slices`. +#' Global filters are gathered in one list element. +#' If a module has no active filters but the global ones, it will not be mentioned in the output. +#' +#' @param mapping_matrix (`data.frame`) of logical vectors where +#' columns represent modules and row represent `teal_slice`s +#' @return `named list` like that in the `mapping` attribute of a `teal_slices` object. +#' @keywords internal +#' +matrix_to_mapping <- function(mapping_matrix) { + 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, ] + + mapping <- c(lapply(local_filters, function(x) rownames(local_filters)[x]), list(global_filters = global_filters)) + Filter(function(x) length(x) != 0L, mapping) +} diff --git a/R/module_tabs_with_filters.R b/R/module_tabs_with_filters.R index 129b31d054..56b49b01e9 100644 --- a/R/module_tabs_with_filters.R +++ b/R/module_tabs_with_filters.R @@ -104,7 +104,7 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter) { is_module_specific <- isTRUE(attr(filter, "module_specific")) teal_ui <- ui_nested_tabs(ns("root"), modules = modules, datasets, is_module_specific = is_module_specific) - filter_panel_btn <- tags$li( + filter_panel_btns <- tags$li( class = "flex-grow", tags$button( class = "btn action-button filter_hamburger", # see sidebar.css for style filter_hamburger @@ -112,12 +112,14 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter) { onclick = "toggleFilterPanel();", # see sidebar.js title = "Toggle filter panels", icon("fas fa-bars") - ) + ), + filter_manager_modal_ui(ns("filter_manager")) ) + teal_ui$children[[1]] <- tagAppendChild(teal_ui$children[[1]], filter_panel_btns) if (!is_module_specific) { # need to rearrange html so that filter panel is within tabset - tabset_bar <- tagAppendChild(teal_ui$children[[1]], filter_panel_btn) + tabset_bar <- teal_ui$children[[1]] teal_modules <- teal_ui$children[[2]] filter_ui <- unlist(datasets)[[1]]$ui_filter_panel(ns("filter_panel")) list( @@ -129,12 +131,6 @@ ui_tabs_with_filters <- function(id, modules, datasets, filter) { ) ) } else { - filter_panel_btn <- tagAppendChild( - filter_panel_btn, - filter_manager_modal_ui(ns("filter_manager")) - ) - # appending buttons to tabset bar - teal_ui$children[[1]] <- tagAppendChild(teal_ui$children[[1]], filter_panel_btn) teal_ui } } @@ -152,13 +148,12 @@ srv_tabs_with_filters <- function(id, datasets, modules, reporter = teal.reporte checkmate::assert_class(modules, "teal_modules") checkmate::assert_list(datasets, types = c("list", "FilteredData")) checkmate::assert_class(reporter, "Reporter") + checkmate::assert_class(filter, "teal_slices") moduleServer(id, function(input, output, session) { logger::log_trace("srv_tabs_with_filters initializing the module.") is_module_specific <- isTRUE(attr(filter, "module_specific")) - if (is_module_specific) { - manager_out <- filter_manager_modal_srv("filter_manager", filtered_data_list = datasets, filter = filter) - } + manager_out <- filter_manager_modal_srv("filter_manager", filtered_data_list = datasets, filter = filter) active_module <- srv_nested_tabs( id = "root", diff --git a/R/module_teal.R b/R/module_teal.R index 4b6bed99ad..93f9c19f48 100644 --- a/R/module_teal.R +++ b/R/module_teal.R @@ -169,7 +169,9 @@ srv_teal <- function(id, modules, raw_data, filter = teal_slices()) { # create a list of data following structure of the nested modules list structure. # Because it's easier to unpack modules and datasets when they follow the same nested structure. datasets_singleton <- teal.slice::init_filtered_data(raw_data()) - datasets_singleton$set_filter_state(filter) + # Singleton starts with only global filters active. + filter_global <- Filter(function(x) x$id %in% attr(filter, "mapping")$global_filters, filter) + datasets_singleton$set_filter_state(filter_global) module_datasets <- function(modules) { if (inherits(modules, "teal_modules")) { datasets <- lapply(modules$children, module_datasets) diff --git a/R/teal_reporter.R b/R/teal_reporter.R index a6656051b4..6835822fa6 100644 --- a/R/teal_reporter.R +++ b/R/teal_reporter.R @@ -82,7 +82,7 @@ TealSlicesBlock <- R6::R6Class( # nolint: object_name_linter. #' @details Returns a `TealSlicesBlock` object with no content and no parameters. #' #' @param content (`teal_slices`) object returned from [teal_slices()] function. - #' @param ... any `rmarkdown` R chunk parameter and it value. + #' @param style (`character(1)`) string specifying style to apply. #' #' @return `TealSlicesBlock` #' @examples diff --git a/R/teal_slices.R b/R/teal_slices.R index 88bed53c94..55ac3a3432 100644 --- a/R/teal_slices.R +++ b/R/teal_slices.R @@ -3,17 +3,20 @@ #' Filter settings for teal applications #' #' @inheritParams teal.slice::teal_slices -#' @param mapping (`named list`)\cr -#' Each element of the list should contain character vector of `teal_slices` `id` (see -#' [teal.slice::teal_slice()]). Filters referred in list elements will be set on the startup of a -#' `teal` application. -#' Names of the list should correspond to `teal_module` `label` set in [module()] function. #' #' @param module_specific (`logical(1)`)\cr #' - `TRUE` when filter panel should be module-specific. All modules can have different set #' of filters specified - see `mapping` argument. #' - `FALSE` when one filter panel needed to all modules. All filters will be shared #' by all modules. +#' @param mapping (`named list`)\cr +#' Specifies which filters will be active in which modules on app start. +#' Elements should contain character vector of `teal_slice` `id`s (see [teal.slice::teal_slice()]). +#' Names of the list should correspond to `teal_module` `label` set in [module()] function. +#' `id`s listed under `"global_filters` will be active in all modules. +#' If missing, all filters will be applied to all modules. +#' If empty list, all filters will be available to all modules but will start inactive. +#' If `module_specific` is `FALSE`, only `global_filters` will be active on start. #' #' @examples #' filter <- teal_slices( @@ -49,45 +52,43 @@ teal_slices <- function(..., include_varnames = NULL, count_type = NULL, allow_add = TRUE, - mapping = list(), - module_specific = length(mapping) > 0) { + module_specific = FALSE, + mapping) { shiny::isolate({ - checkmate::assert_list(mapping, names = "named") - checkmate::assert_flag(module_specific) checkmate::assert_flag(allow_add) - modules_mapped <- setdiff(names(mapping), "global_filters") - if (length(modules_mapped) && !module_specific) { - stop( - "`mapping` is specified for modules (", toString(modules_mapped), ") even though `module_specific` isn't TRUE.", - "Please set module_specific to `TRUE` or specify filters without mapping." - ) + checkmate::assert_flag(module_specific) + if (!missing(mapping)) checkmate::assert_list(mapping, types = c("character", "NULL"), names = "named") + + slices <- list(...) + all_slice_id <- vapply(slices, `[[`, character(1L), "id") + + if (missing(mapping)) { + mapping <- list(global_filters = all_slice_id) + } + if (!module_specific) { + mapping[setdiff(names(mapping), "global_filters")] <- NULL + } + + failed_slice_id <- setdiff(unlist(mapping), all_slice_id) + if (length(failed_slice_id)) { + stop(sprintf( + "Filters in mapping don't match any available filter.\n %s not in %s", + toString(failed_slice_id), + toString(all_slice_id) + )) } - fs <- teal.slice::teal_slices( + tss <- teal.slice::teal_slices( ..., exclude_varnames = exclude_varnames, include_varnames = include_varnames, count_type = count_type, allow_add = allow_add ) - - all_slice_id <- vapply(fs, `[[`, character(1), "id") - for (i in names(mapping)) { - failed_slice_id <- setdiff(mapping[[i]], all_slice_id) - if (length(failed_slice_id)) { - stop(sprintf( - "id of filters in mapping '%s' don't match any available filter.\n %s not in %s", - i, - toString(failed_slice_id), - toString(all_slice_id) - )) - } - } - - attr(fs, "mapping") <- mapping - attr(fs, "module_specific") <- module_specific - class(fs) <- c("modules_teal_slices", class(fs)) - fs + attr(tss, "mapping") <- mapping + attr(tss, "module_specific") <- module_specific + class(tss) <- c("modules_teal_slices", class(tss)) + tss }) } diff --git a/R/zzz.R b/R/zzz.R index 7f17b85729..8449e5473c 100644 --- a/R/zzz.R +++ b/R/zzz.R @@ -23,9 +23,10 @@ ) } -# Use non-exported function from teal.slice. +# Use non-exported function(s) from teal.slice. # This is a temporary measure and will be removed two release cycles from now (now meaning 0.13.0). as.teal_slices <- getFromNamespace("as.teal_slices", "teal.slice") # nolint - +# This one is here because setdiff_teal_slice should not be exported from teal.slice. +setdiff_teal_slices <- getFromNamespace("setdiff_teal_slices", "teal.slice") # all *Block objects are private in teal.reporter RcodeBlock <- getFromNamespace("RcodeBlock", "teal.reporter") # nolint diff --git a/inst/css/sidebar.css b/inst/css/sidebar.css index dbcda10ae2..773970b1b8 100644 --- a/inst/css/sidebar.css +++ b/inst/css/sidebar.css @@ -1,15 +1,7 @@ /* teal sidebar css */ -.filter_manager_button { - font-size: 16px; - padding: 8px !important; - float: right !important; - background-color: transparent !important; -} - -/* filter hamburger btn */ -.filter_hamburger { +.filter_hamburger, .filter_manager_button { font-size: 16px; padding: 8px !important; float: right !important; @@ -22,3 +14,29 @@ a.disabled { cursor: not-allowed; color: grey; } + +.filter_manager_content { + display: flex; + flex-direction: row; + flex-wrap: wrap; + align-items: flex-start; + justify-content: center; +} +.filter_manager_content > * { + flex: 1 1 auto; + padding: 0em 1em; + width: min-content; +} + +.snapshot_table_row { + display: flex; + flex-direction: row; + align-items: center; +} +.snapshot_table_row *:first-child { + flex: 1 1 80%; +} +.snapshot_table_row * + * { + flex: 1 0 50px; + padding: 0em 1em; +} diff --git a/inst/js/sidebar.js b/inst/js/sidebar.js index c3f8dddab8..9672f16c14 100644 --- a/inst/js/sidebar.js +++ b/inst/js/sidebar.js @@ -5,6 +5,7 @@ const hideSidebar = () => { $(".teal_primary_col").attr("class", "teal_primary_col col-sm-12").resize(); }; const showSidebar = () => { + debugger; $(".teal_primary_col").attr("class", "teal_primary_col col-sm-9").resize(); $(".teal_secondary_col").delay(600).fadeIn(50); }; diff --git a/man/TealSlicesBlock.Rd b/man/TealSlicesBlock.Rd index a2438ad074..29031fda9a 100644 --- a/man/TealSlicesBlock.Rd +++ b/man/TealSlicesBlock.Rd @@ -55,7 +55,7 @@ Returns a \code{TealSlicesBlock} object. \describe{ \item{\code{content}}{(\code{teal_slices}) object returned from \code{\link[=teal_slices]{teal_slices()}} function.} -\item{\code{...}}{any \code{rmarkdown} R chunk parameter and it value.} +\item{\code{style}}{(\code{character(1)}) string specifying style to apply.} } \if{html}{\out{}} } diff --git a/man/disassemble_slices.Rd b/man/disassemble_slices.Rd new file mode 100644 index 0000000000..b8a21af5c2 --- /dev/null +++ b/man/disassemble_slices.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_snapshot_manager.R +\name{disassemble_slices} +\alias{disassemble_slices} +\title{Convert teal_slices and to list of lists (drop classes), while maintaining attributes. +Adds special class so that the reverse action can have assertion on argument type.} +\usage{ +disassemble_slices(tss) +} +\arguments{ +\item{tss}{(\code{teal_slices})} +} +\value{ +Object of class \code{teal_slices_snapshot}, which is a list of the same length as \code{tss}, +where each \code{teal_slice} has been converted to a list. +} +\description{ +Convert teal_slices and to list of lists (drop classes), while maintaining attributes. +Adds special class so that the reverse action can have assertion on argument type. +} +\keyword{internal} diff --git a/man/filter_manager_module_srv.Rd b/man/filter_manager_module_srv.Rd index 5f945929a9..d5ef33f781 100644 --- a/man/filter_manager_module_srv.Rd +++ b/man/filter_manager_module_srv.Rd @@ -4,7 +4,7 @@ \alias{filter_manager_module_srv} \title{Module specific filter manager} \usage{ -filter_manager_module_srv(id, module_fd, slices_map_module, slices_global) +filter_manager_module_srv(id, module_fd, slices_global) } \arguments{ \item{id}{(\code{character(1)})\cr @@ -13,23 +13,25 @@ filter_manager_module_srv(id, module_fd, slices_map_module, slices_global) \item{module_fd}{(\code{FilteredData})\cr object to filter data in the teal-module} -\item{slices_map_module}{(\code{reactiveVal} of \code{character})\cr -\code{id} of the \code{teal_slice} objects used in the module specific \code{FilteredData}.} - -\item{slices_global}{(\code{reactiveVal} or \code{teal_slices})\cr -stores a list of all available filters which can be utilized in several ways, for example: +\item{slices_global}{(\code{reactiveVal})\cr +stores \code{teal_slices} with all available filters; allows the following actions: \itemize{ -\item to disable/enable specific filter in the module -\item to restore filter saved settings -\item to save current filter settings panel +\item to disable/enable a specific filter in a module +\item to restore saved filter settings +\item to save current filter panel settings }} } \value{ -shiny module returning NULL +A \code{reactive} expression containing the slices active in this module. } \description{ -This module compares filters between single \code{FilteredData} settings -and global \code{teal_slices}. Updates appropriate objects \code{module_fd}, -\code{slices_map_module}, \code{slices_global} to keep them consistent. +Track filter states in single module. +} +\details{ +This module tracks the state of a single \code{FilteredData} object and global \code{teal_slices} +and updates both objects as necessary. Filter states added in different modules +Filter states added any individual module are added to global \code{teal_slices} +and from there become available in other modules +by setting \code{private$available_teal_slices} in each \code{FilteredData}. } \keyword{internal} diff --git a/man/matrix_to_mapping.Rd b/man/matrix_to_mapping.Rd new file mode 100644 index 0000000000..67b1d96d57 --- /dev/null +++ b/man/matrix_to_mapping.Rd @@ -0,0 +1,22 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_snapshot_manager.R +\name{matrix_to_mapping} +\alias{matrix_to_mapping} +\title{Convert mapping matrix to filter mapping specification.} +\usage{ +matrix_to_mapping(mapping_matrix) +} +\arguments{ +\item{mapping_matrix}{(\code{data.frame}) of logical vectors where +columns represent modules and row represent \code{teal_slice}s} +} +\value{ +\verb{named list} like that in the \code{mapping} attribute of a \code{teal_slices} object. +} +\description{ +Transform a mapping matrix, i.e. a data frame that maps each filter state to each module, +to a list specification like the one used in the \code{mapping} attribute of \code{teal_slices}. +Global filters are gathered in one list element. +If a module has no active filters but the global ones, it will not be mentioned in the output. +} +\keyword{internal} diff --git a/man/module_filter_manager.Rd b/man/module_filter_manager.Rd index 21529e38a3..5428396151 100644 --- a/man/module_filter_manager.Rd +++ b/man/module_filter_manager.Rd @@ -13,22 +13,27 @@ filter_manager_srv(id, filtered_data_list, filter) \item{id}{(\code{character(1)})\cr \code{shiny} module id.} -\item{filtered_data_list}{(\code{list} of \code{FilteredData})\cr -Names of the list should be the same as \code{teal_module$label}.} +\item{filtered_data_list}{(\verb{named list})\cr +A list, possibly nested, of \code{FilteredData} objects. +Each \code{FilteredData} will be served to one module in the \code{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.} \item{filter}{(\code{teal_slices})\cr Specification of initial filter. Filters can be specified using \code{\link[=teal_slices]{teal_slices()}}. Old way of specifying filters through a list is deprecated and will be removed in the next release. Please fix your applications to use \code{\link[=teal_slices]{teal_slices()}}.} } +\value{ +A list of \code{reactive}s, each holding a \code{teal_slices}, as returned by \code{filter_manager_module_srv}. +} \description{ -Manage multiple \code{FilteredData} objects +Oversee filter states in the whole application. } \details{ This module observes the changes of the filters in each \code{FilteredData} object -and keeps track of all filters used. Map of the filters is kept in so called -\code{slices_map} object where each \code{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 \code{filtered_data_list} (named after teal modules). +and keeps track of all filters used. A mapping of filters to modules +is kept in the \code{mapping_matrix} object (which is actually a \code{data.frame}) +that tracks which filters (rows) are active in which modules (columns). } \keyword{internal} diff --git a/man/module_filter_manager_modal.Rd b/man/module_filter_manager_modal.Rd index 753314691f..4ae0922fba 100644 --- a/man/module_filter_manager_modal.Rd +++ b/man/module_filter_manager_modal.Rd @@ -14,8 +14,11 @@ filter_manager_modal_srv(id, filtered_data_list, filter) \item{id}{(\code{character(1)})\cr \code{shiny} module id.} -\item{filtered_data_list}{(\code{list} of \code{FilteredData})\cr -Names of the list should be the same as \code{teal_module$label}.} +\item{filtered_data_list}{(\verb{named list})\cr +A list, possibly nested, of \code{FilteredData} objects. +Each \code{FilteredData} will be served to one module in the \code{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.} \item{filter}{(\code{teal_slices})\cr Specification of initial filter. Filters can be specified using \code{\link[=teal_slices]{teal_slices()}}. @@ -23,7 +26,7 @@ Old way of specifying filters through a list is deprecated and will be removed i next release. Please fix your applications to use \code{\link[=teal_slices]{teal_slices()}}.} } \description{ -Filter manager modal +Opens modal containing the filter manager UI. } \examples{ fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) @@ -60,5 +63,6 @@ app <- shinyApp( if (interactive()) { runApp(app) } + } \keyword{internal} diff --git a/man/reassemble_slices.Rd b/man/reassemble_slices.Rd new file mode 100644 index 0000000000..cb63e903fb --- /dev/null +++ b/man/reassemble_slices.Rd @@ -0,0 +1,18 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_snapshot_manager.R +\name{reassemble_slices} +\alias{reassemble_slices} +\title{Rebuild \code{teal_slices} from \code{teal_slices_snapshot}.} +\usage{ +reassemble_slices(x) +} +\arguments{ +\item{x}{(\code{teal_slices_snapshot})} +} +\value{ +A \code{teal_slices} object. +} +\description{ +Rebuild \code{teal_slices} from \code{teal_slices_snapshot}. +} +\keyword{internal} diff --git a/man/snapshot_manager_module.Rd b/man/snapshot_manager_module.Rd new file mode 100644 index 0000000000..3dbab564fc --- /dev/null +++ b/man/snapshot_manager_module.Rd @@ -0,0 +1,88 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_snapshot_manager.R +\name{snapshot_manager_module} +\alias{snapshot_manager_module} +\alias{snapshot_manager_ui} +\alias{snapshot} +\alias{snapshot_manager} +\alias{snapshot_manager_srv} +\title{Filter state snapshot management.} +\usage{ +snapshot_manager_ui(id) + +snapshot_manager_srv(id, slices_global, mapping_matrix, filtered_data_list) +} +\arguments{ +\item{id}{(\code{character(1)}) \code{shiny} module id} + +\item{slices_global}{(\code{reactiveVal}) that contains a \code{teal_slices} object +containing all \code{teal_slice}s existing in the app, both active and inactive} + +\item{mapping_matrix}{(\code{reactive}) that contains a \code{data.frame} representation +of the mapping of filter state ids (rows) to modules labels (columns); +all columns are \code{logical} vectors} + +\item{filtered_data_list}{non-nested (\verb{named list}) that contains \code{FilteredData} objects} +} +\value{ +Nothing is returned. +} +\description{ +Capture and restore snapshots of the global (app) filter state. +} +\details{ +This module introduces snapshots: stored descriptions of the filter state of the entire application. +Snapshots allow the user to save the current filter state of the application for later use in the session, +as well as to save it to file in order to share it with an app developer or other users. + +The snapshot manager is accessed through the filter manager, with the cog icon in the top right corner. +At the beginning of a session it presents two icons: a camera and an circular arrow. +Clicking the camera captures a snapshot and clicking the arrow resets initial application state. +As snapshots are added, they will show up as rows in a table and each will have a select button and a save button. +} +\section{Server logic}{ + +Snapshots are basically \code{teal_slices} objects, however, since each module is served by a separate instance +of \code{FilteredData} and these objects require shared state, \code{teal_slice} is a \code{reactiveVal} so \code{teal_slices} +cannot be stored as is. Therefore, \code{teal_slices} are reversibly converted to a list of lists representation +(attributes are maintained). + +Snapshots are stored in a \code{reactiveVal} as a named list. +The first snapshot is the initial state of the application and the user can add a snapshot whenever they see fit. + +For every snapshot except the initial one, a piece of UI is generated that contains +the snapshot name, a select button to restore that snapshot, and a save button to save it to a file. +The initial snapshot is restored by a separate "reset" button. +It cannot be saved directly but a user is welcome to capture the initial state as a snapshot and save that. +} + +\section{Snapshot mechanics}{ + +When a snapshot is captured, the user is prompted to name it. +Names are displayed as is but since they are used to create button ids, +under the hood they are converted to syntactically valid strings. +New snapshot names are validated so that their valid versions are unique. +Leading and trailing white space is trimmed. + +The module can read the global state of the application from \code{slices_global} and \code{mapping_matrix}. +The former provides a list of all existing \code{teal_slice}s and the latter says which slice is active in which module. +Once a name has been accepted, \code{slices_global} is converted to a list of lists - a snapshot. +The snapshot contains the \code{mapping} attribute of the initial application state +(or one that has been restored), which may not reflect the current one, +so \code{mapping_matrix} is transformed to obtain the current mapping, i.e. a list that, +when passed to the \code{mapping} argument of \code{\link{teal_slices}}, would result in the current mapping. +This is substituted as the snapshot's \code{mapping} attribute and the snapshot is added to the snapshot list. + +To restore app state, a snapshot is retrieved from storage and rebuilt into a \code{teal_slices} object. +Then state of all \code{FilteredData} objects (provided in \code{filtered_data_list}) is cleared +and set anew according to the \code{mapping} attribute of the snapshot. +The snapshot is then set as the current content of \code{slices_global}. + +To save a snapshot, the snapshot is retrieved and reassembled just like for restoring, +and then saved to file with \code{\link[teal.slice:slices_store]{teal.slice::slices_store}}. +} + +\author{ +Aleksander Chlebowski +} +\keyword{internal} diff --git a/man/teal_slices.Rd b/man/teal_slices.Rd index ac8165f35a..691b7011f3 100644 --- a/man/teal_slices.Rd +++ b/man/teal_slices.Rd @@ -10,8 +10,8 @@ teal_slices( include_varnames = NULL, count_type = NULL, allow_add = TRUE, - mapping = list(), - module_specific = length(mapping) > 0 + module_specific = FALSE, + mapping ) } \arguments{ @@ -33,12 +33,6 @@ Please make sure that adding new filters doesn't fail on target platform before \item{allow_add}{(\code{logical(1)}) logical flag specifying whether the user will be able to add new filters} -\item{mapping}{(\verb{named list})\cr -Each element of the list should contain character vector of \code{teal_slices} \code{id} (see -\code{\link[teal.slice:teal_slice]{teal.slice::teal_slice()}}). Filters referred in list elements will be set on the startup of a -\code{teal} application. -Names of the list should correspond to \code{teal_module} \code{label} set in \code{\link[=module]{module()}} function.} - \item{module_specific}{(\code{logical(1)})\cr \itemize{ \item \code{TRUE} when filter panel should be module-specific. All modules can have different set @@ -46,6 +40,15 @@ of filters specified - see \code{mapping} argument. \item \code{FALSE} when one filter panel needed to all modules. All filters will be shared by all modules. }} + +\item{mapping}{(\verb{named list})\cr +Specifies which filters will be active in which modules on app start. +Elements should contain character vector of \code{teal_slice} \code{id}s (see \code{\link[teal.slice:teal_slice]{teal.slice::teal_slice()}}). +Names of the list should correspond to \code{teal_module} \code{label} set in \code{\link[=module]{module()}} function. +\code{id}s listed under \verb{"global_filters} will be active in all modules. +If missing, all filters will be applied to all modules. +If empty list, all filters will be available to all modules but will start inactive. +If \code{module_specific} is \code{FALSE}, only \code{global_filters} will be active on start.} } \description{ Filter settings for teal applications diff --git a/man/ui_nested_tabs.Rd b/man/ui_nested_tabs.Rd index 64ac54ff48..2f34dc0f8b 100644 --- a/man/ui_nested_tabs.Rd +++ b/man/ui_nested_tabs.Rd @@ -30,8 +30,8 @@ details see \code{\link[teal.slice:FilteredData]{teal.slice::FilteredData}}} number which helps to determine depth of the modules nesting.} \item{is_module_specific}{(\code{logical(1)})\cr -flag determining if the filter panel is global or module-specific. When \code{module_specific} -is \code{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 \code{TRUE}, a filter panel is called inside of each module tab.} } \value{ depending on class of \code{modules}: diff --git a/man/unfold_mapping.Rd b/man/unfold_mapping.Rd new file mode 100644 index 0000000000..ee6dda2e06 --- /dev/null +++ b/man/unfold_mapping.Rd @@ -0,0 +1,20 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/module_snapshot_manager.R +\name{unfold_mapping} +\alias{unfold_mapping} +\title{Explicitly enumerate global filters.} +\usage{ +unfold_mapping(mapping, module_names) +} +\arguments{ +\item{mapping}{(\verb{named list}) as stored in mapping parameter of \code{teal_slices}} + +\item{module_names}{(\code{character}) vector containing names of all modules in the app} +} +\value{ +A \code{named_list} with one element per module, each element containing all filters applied to that module. +} +\description{ +Transform module mapping such that global filters are explicitly specified for every module. +} +\keyword{internal} diff --git a/tests/testthat/test-filter_manager.R b/tests/testthat/test-filter_manager.R index 1532c67e20..9cc0bd8d91 100644 --- a/tests/testthat/test-filter_manager.R +++ b/tests/testthat/test-filter_manager.R @@ -1,8 +1,21 @@ -filter <- teal_slices( +filter_global <- teal_slices( teal.slice::teal_slice(dataname = "iris", varname = "Sepal.Length"), teal.slice::teal_slice(dataname = "iris", varname = "Species"), teal.slice::teal_slice(dataname = "mtcars", varname = "mpg"), teal.slice::teal_slice(dataname = "women", varname = "height"), + module_specific = TRUE, + mapping = list( + m1 = c("iris Sepal.Length"), + m3 = c("women height"), + global_filters = "iris Species" + ) +) +filter_modular <- teal_slices( + teal.slice::teal_slice(dataname = "iris", varname = "Sepal.Length"), + teal.slice::teal_slice(dataname = "iris", varname = "Species"), + teal.slice::teal_slice(dataname = "mtcars", varname = "mpg"), + teal.slice::teal_slice(dataname = "women", varname = "height"), + module_specific = FALSE, mapping = list( m1 = c("iris Sepal.Length"), m3 = c("women height"), @@ -10,7 +23,7 @@ filter <- teal_slices( ) ) -testthat::test_that("filter_manager_srv initializes objects based on initial filter configuration", { +testthat::test_that("filter_manager_srv initializes properly processes input arguments", { fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) fd2 <- teal.slice::init_filtered_data( list(iris = list(dataset = iris), mtcars = list(dataset = mtcars)) @@ -23,33 +36,33 @@ testthat::test_that("filter_manager_srv initializes objects based on initial fil tab = list(m2 = fd2, m3 = fd3) ) + # global filtering shiny::testServer( app = filter_manager_srv, args = list( id = "test", filtered_data_list = filtered_data_list, - filter = filter + filter = filter_global ), expr = { testthat::expect_named(filtered_data_list, c("m1", "m2", "m3")) - testthat::expect_identical(slices_map$m1(), c("iris Sepal.Length", "iris Species")) - testthat::expect_identical(slices_map$m2(), "iris Species") - testthat::expect_identical(slices_map$m3(), c("women height", "iris Species")) - testthat::expect_identical(slices_global(), filter) + } + ) - testthat::expect_identical( - mapping_matrix(), - as.matrix( - data.frame( - m1 = c(TRUE, TRUE, FALSE, FALSE), - m2 = c(FALSE, TRUE, FALSE, FALSE), - m3 = c(FALSE, TRUE, FALSE, TRUE), - row.names = c("iris Sepal.Length", "iris Species", "mtcars mpg", "women height") - ) - ) - ) + # modular filtering + shiny::testServer( + app = filter_manager_srv, + args = list( + id = "test", + filtered_data_list = filtered_data_list, + filter = filter_modular + ), + expr = { + testthat::expect_named(filtered_data_list, "global_filters") + + testthat::expect_identical(slices_global(), filter) } ) }) diff --git a/tests/testthat/test-init.R b/tests/testthat/test-init.R index 09a2e8732b..834da959d0 100644 --- a/tests/testthat/test-init.R +++ b/tests/testthat/test-init.R @@ -158,48 +158,3 @@ testthat::test_that("init filter accepts named list or `teal_slices`", { testthat::expect_no_error(init(data = dataset_1, modules = mods, filter = fs)) testthat::expect_error(init(data = dataset_1, modules = mods, filter = unclass(fs)), "Assertion failed") }) - -testthat::test_that("init filter fails when filters don't refer to available data names", { - testthat::expect_error( - init( - data = list(iris = iris), - modules = teal:::example_modules(), - filter = teal.slice::teal_slices( - teal.slice::teal_slice(dataname = "inexisting", varname = "varname") - ) - ), - "inexisting not in iris" - ) -}) - -testthat::test_that("init filter fails when mapping don't refer to available module labels", { - testthat::expect_error( - init( - data = list(iris = iris), - modules = teal:::example_modules(), - filter = teal_slices( - teal.slice::teal_slice(dataname = "iris", varname = "varname", id = "iris varname"), - mapping = list( - inexisting = c("iris varname") - ) - ) - ), - "inexisting not in aaa1, aaa2, aaa3" - ) -}) - -testthat::test_that("init filter fails when mapping don't refer to available filter id", { - testthat::expect_error( - init( - data = list(iris = iris), - modules = teal:::example_modules(), - filter = teal_slices( - teal.slice::teal_slice(dataname = "iris", varname = "varname", id = "iris varname"), - mapping = list( - aaa1 = "inexisting" - ) - ) - ), - "inexisting not in iris varname" - ) -}) diff --git a/tests/testthat/test-module_tabs_with_filters.R b/tests/testthat/test-module_tabs_with_filters.R index 68b1dd7b5d..b65c0a56f8 100644 --- a/tests/testthat/test-module_tabs_with_filters.R +++ b/tests/testthat/test-module_tabs_with_filters.R @@ -67,7 +67,7 @@ testthat::test_that("active_datanames() returns dataname from single tab", { id = "test", datasets = list(`iris tab` = filtered_data), modules = modules(test_module1), - filter = list() + filter = teal_slices() ), expr = { testthat::expect_identical(active_datanames(), "iris") @@ -82,7 +82,7 @@ testthat::test_that("active_datanames() returns dataname from active tab after c id = "test", datasets = list(`iris tab` = filtered_data, `mtcars tab` = filtered_data), modules = modules(test_module1, test_module2), - filter = list(), + filter = teal_slices(), reporter = teal.reporter::Reporter$new() ), expr = { diff --git a/tests/testthat/test-modules.R b/tests/testthat/test-modules.R index efacb92b84..88b9b9f8fa 100644 --- a/tests/testthat/test-modules.R +++ b/tests/testthat/test-modules.R @@ -512,67 +512,3 @@ testthat::test_that("append_module produces teal_modules with unique named child mod_names <- names(appended_mods$children) testthat::expect_equal(mod_names, unique(mod_names)) }) - -testthat::test_that("teal_slices fails when inexisting teal_slice id is specified in mapping", { - testthat::expect_error( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), - mapping = list( - module = "inexisting" - ) - ) - ) -}) - -testthat::test_that("teal_slices returns modules_teal_slices", { - testthat::expect_s3_class( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test") - ), - "modules_teal_slices" - ) -}) - -testthat::test_that("teal_slices mapping should be an empty list or a named list", { - testthat::expect_no_error( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), - mapping = list() - ) - ) - testthat::expect_no_error( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), - mapping = list(module = c()) - ) - ) - testthat::expect_error( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), - mapping = list(1, 2, 3) - ) - ) -}) - -testthat::test_that("teal_slices fails when inexisting teal_slice id is specified in mapping", { - testthat::expect_error( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), - mapping = list( - module = "inexisting" - ) - ), - "inexisting not in test" - ) -}) - -testthat::test_that("teal_slices fails when mapping is specified with module_specific = FALSE", { - testthat::expect_error( - teal_slices( - teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), - mapping = list(module = "test"), - module_specific = FALSE - ), - "`mapping` is specified .+ even though `module_specific` isn't TRUE" - ) -}) diff --git a/tests/testthat/test-snapshot_manager.R b/tests/testthat/test-snapshot_manager.R new file mode 100644 index 0000000000..9e7a70e311 --- /dev/null +++ b/tests/testthat/test-snapshot_manager.R @@ -0,0 +1,46 @@ +testthat::test_that("snapshot manager holds initial state in history", { + filter <- teal_slices( + teal.slice::teal_slice(dataname = "iris", varname = "Sepal.Length"), + teal.slice::teal_slice(dataname = "iris", varname = "Species"), + teal.slice::teal_slice(dataname = "mtcars", varname = "mpg"), + teal.slice::teal_slice(dataname = "women", varname = "height"), + mapping = list( + m1 = c("iris Sepal.Length"), + m3 = c("women height"), + global_filters = "iris Species" + ) + ) + + fd1 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris))) + fd2 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), mtcars = list(dataset = mtcars))) + fd3 <- teal.slice::init_filtered_data(list(iris = list(dataset = iris), women = list(dataset = women))) + filtered_data_list <- list(m1 = fd1, m2 = fd2, m3 = fd3) + + slices_global <- reactiveVal(shiny::isolate(filter)) + + 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) + }) + + shiny::testServer( + app = snapshot_manager_srv, + args = list( + id = "test", + slices_global = slices_global, + mapping_matrix = mapping_matrix, + filtered_data_list = filtered_data_list + ), + expr = { + testthat::expect_true("Initial application state" %in% names(snapshot_history())) + + snapshot <- snapshot_history()[["Initial application state"]] + snapshot_state <- reassemble_slices(snapshot) + + testthat::expect_equal(disassemble_slices(snapshot_state), disassemble_slices(filter)) + } + ) +}) diff --git a/tests/testthat/test-teal_slices.R b/tests/testthat/test-teal_slices.R index c1a6d6d4e1..1c556d2496 100644 --- a/tests/testthat/test-teal_slices.R +++ b/tests/testthat/test-teal_slices.R @@ -1,10 +1,95 @@ testthat::test_that("teal_slices produces teal_slices object with teal-specific-attributes", { tss <- teal_slices() testthat::expect_s3_class(tss, "teal_slices") - testthat::expect_identical(attr(tss, "mapping"), list()) + testthat::expect_s3_class(tss, "modules_teal_slices") + testthat::expect_true(is.list(attr(tss, "mapping"))) testthat::expect_identical(attr(tss, "module_specific"), FALSE) }) +testthat::test_that("teal_slices fails when inexisting teal_slice id is specified in mapping", { + testthat::expect_no_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + module_specific = FALSE, + mapping = list( + module = "inexisting" + ) + ) + ) + testthat::expect_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + module_specific = TRUE, + mapping = list( + module = "inexisting" + ) + ), + "Filters in mapping don't match any available filter" + ) +}) + + +testthat::test_that("teal_slices processes filter mapping", { + # if missing, all filters are global + tss <- teal_slices( + teal.slice::teal_slice("iris", "Species"), + teal.slice::teal_slice("mtcars", "mpg") + ) + testthat::expect_identical( + attr(tss, "mapping"), + list(global_filters = c("iris Species", "mtcars mpg")) + ) + # if empty, no filters are global + tss <- teal_slices( + teal.slice::teal_slice("iris", "Species"), + teal.slice::teal_slice("mtcars", "mpg"), + mapping = list() + ) + testthat::expect_true(is.list(attr(tss, "mapping")) && length(attr(tss, "mapping")) == 0L) + # if partial mapping defined, global unaffected + tss <- teal_slices( + teal.slice::teal_slice("iris", "Species"), + teal.slice::teal_slice("mtcars", "mpg"), + mapping = list() + ) +}) + +testthat::test_that("teal_slices drops non-global filters if module_specific = FALSE", { + tss <- teal_slices( + teal.slice::teal_slice("iris", "Species"), + teal.slice::teal_slice("mtcars", "mpg"), + module_specific = TRUE, + mapping = list( + mod1 = "iris Species", + mod2 = "mtcars mpg" + ) + ) + testthat::expect_identical( + attr(tss, "mapping"), + list( + mod1 = "iris Species", + mod2 = "mtcars mpg" + ) + ) + + tss <- teal_slices( + teal.slice::teal_slice("iris", "Species"), + teal.slice::teal_slice("mtcars", "mpg"), + module_specific = FALSE, + mapping = list( + mod1 = "iris Species", + mod2 = "mtcars mpg" + ) + ) + testthat::expect_true(is.list(attr(tss, "mapping")) && length(attr(tss, "mapping")) == 0L) +}) + + + + + + + testthat::test_that("deep_copy_filters copies teal_slice changes pointer of teal_slice object but values remain the same", { @@ -28,3 +113,55 @@ testthat::test_that("deep_copy_filters copies teal_slice changes pointer of teal } ) }) + + + + + + + +# from different file + + + +testthat::test_that("teal_slices mapping should be an empty list or a named list or missing", { + testthat::expect_no_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test") + ) + ) + testthat::expect_no_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + mapping = list() + ) + ) + testthat::expect_no_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + mapping = list(module = c()) + ) + ) + testthat::expect_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + mapping = list("1", "2", "3") + ), + "Assertion.+failed" + ) + testthat::expect_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + mapping = list(1, 2, 3) + ), + "Assertion.+failed" + ) + + testthat::expect_error( + teal_slices( + teal.slice::teal_slice(dataname = "data", varname = "var", id = "test"), + mapping = "mapping" + ), + "Assertion.+failed" + ) +})