From a835f3d70df7232977818ea576e282f54ade860c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Andr=C3=A9=20Ver=C3=ADssimo?= <211358+averissimo@users.noreply.github.com> Date: Mon, 7 Aug 2023 13:03:07 +0200 Subject: [PATCH] 545 Keep selected variable in var browser as filters are changed (#549) MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit # Pull Request Fixes #545 Fixes https://github.com/insightsengineering/teal.gallery/issues/19 #### Changes description - Restores the selection based on the selection _(using variable name instead of indexes)_ - Restores the page _(non-trivial as it needs to calculate the index of the first row in the table)_ #### TODO before ready to review: - [x] Support selection on non-first page rows - uses `displayStart` to set the first row of the page of the selected item --------- Signed-off-by: André Veríssimo <211358+averissimo@users.noreply.github.com> Co-authored-by: github-actions <41898282+github-actions[bot]@users.noreply.github.com> Co-authored-by: Dawid Kałędkowski <6959016+gogonzo@users.noreply.github.com> --- NEWS.md | 1 + R/tm_variable_browser.R | 176 ++++++++++++++++++++++------------------ man/render_tab_table.Rd | 5 +- 3 files changed, 101 insertions(+), 81 deletions(-) diff --git a/NEWS.md b/NEWS.md index 33a644365..b08d36ed0 100644 --- a/NEWS.md +++ b/NEWS.md @@ -17,6 +17,7 @@ * Fixed a bug in `tm_g_scatterplot` when selected x and y facets were the same. * Fixed a bug in `tm_g_distribution` to plot the theoretical distribution with newer `ggplot2` version. * Fixed a bug in `tm_g_bivariate` when adding lines checkbox was available if one of x or y was deselected. +* Fixed a bug in `tm_variable_browser` when changing filters would reset the selected variable to the first on the list. ### Miscellaneous diff --git a/R/tm_variable_browser.R b/R/tm_variable_browser.R index 7a416e246..63222d45e 100644 --- a/R/tm_variable_browser.R +++ b/R/tm_variable_browser.R @@ -1117,7 +1117,8 @@ render_single_tab <- function(dataset_name, parent_dataname, output, data, input output = output, data = data, input = input, - columns_names = columns_names + columns_names = columns_names, + plot_var = plot_var ) } @@ -1154,98 +1155,113 @@ render_tab_header <- function(dataset_name, output, data) { #' @param parent_dataname (`character`) the name of a parent `dataname` to filter out variables from #' @inheritParams render_tabset_panel_content #' @keywords internal -render_tab_table <- function(dataset_name, parent_dataname, output, data, input, columns_names) { +render_tab_table <- function(dataset_name, parent_dataname, output, data, input, columns_names, plot_var) { table_ui_id <- paste0("variable_browser_", dataset_name) - output[[table_ui_id]] <- DT::renderDataTable( - expr = { - df <- data[[dataset_name]]() + output[[table_ui_id]] <- DT::renderDataTable({ + df <- data[[dataset_name]]() - get_vars_df <- function(input, dataset_name, parent_name, data) { - data_cols <- colnames(data[[dataset_name]]()) - if (isTRUE(input$show_parent_vars)) { - data_cols - } else if (dataset_name != parent_name && parent_name %in% names(data)) { - setdiff(data_cols, colnames(data[[parent_name]]())) - } else { - data_cols - } + get_vars_df <- function(input, dataset_name, parent_name, data) { + data_cols <- colnames(data[[dataset_name]]()) + if (isTRUE(input$show_parent_vars)) { + data_cols + } else if (dataset_name != parent_name && parent_name %in% names(data)) { + setdiff(data_cols, colnames(data[[parent_name]]())) + } else { + data_cols } + } + + if (length(parent_dataname) > 0) { + df_vars <- get_vars_df(input, dataset_name, parent_dataname, data) + df <- df[df_vars] + } - if (length(parent_dataname) > 0) { - df_vars <- get_vars_df(input, dataset_name, parent_dataname, data) - df <- df[df_vars] + if (is.null(df) || ncol(df) == 0) { + columns_names[[dataset_name]] <- character(0) + df_output <- data.frame( + Type = character(0), + Variable = character(0), + Label = character(0), + Missings = character(0), + Sparklines = character(0), + stringsAsFactors = FALSE + ) + } else { + # extract data variable labels + labels <- teal.data::col_labels(df) + + columns_names[[dataset_name]] <- names(labels) + + # calculate number of missing values + missings <- vapply( + df, + var_missings_info, + FUN.VALUE = character(1), + USE.NAMES = FALSE + ) + + # get icons proper for the data types + icons <- stats::setNames(teal.slice:::variable_types(df), colnames(df)) + + join_keys <- get_join_keys(data) + if (!is.null(join_keys)) { + icons[intersect(join_keys$get(dataset_name)[[dataset_name]], colnames(df))] <- "primary_key" } + icons <- variable_type_icons(icons) + + # generate sparklines + sparklines_html <- vapply( + df, + create_sparklines, + FUN.VALUE = character(1), + USE.NAMES = FALSE + ) - if (is.null(df) || ncol(df) == 0) { - columns_names[[dataset_name]] <- character(0) - data.frame( - Type = character(0), - Variable = character(0), - Label = character(0), - Missings = character(0), - Sparklines = character(0), - stringsAsFactors = FALSE - ) - } else { - # extract data variable labels - labels <- stats::setNames( - unlist( - lapply( - df, - function(x) { - `if`(is.null(attr(x, "label")), "", attr(x, "label")) - } - ) - ), - names(df) - ) + df_output <- data.frame( + Type = icons, + Variable = names(labels), + Label = labels, + Missings = missings, + Sparklines = sparklines_html, + stringsAsFactors = FALSE + ) + } - columns_names[[dataset_name]] <- names(labels) + # Select row 1 as default / fallback + selected_ix <- 1 + # Define starting page index (base-0 index of the first item on page + # note: in many cases it's not the item itself + selected_page_ix <- 0 - # calculate number of missing values - missings <- vapply( - df, - var_missings_info, - FUN.VALUE = character(1), - USE.NAMES = FALSE - ) + # Retrieve current selected variable if any + isolated_variable <- shiny::isolate(plot_var$variable[[dataset_name]]) - # get icons proper for the data types - icons <- stats::setNames(teal.slice:::variable_types(df), colnames(df)) + if (!is.null(isolated_variable)) { + index <- which(columns_names[[dataset_name]] == isolated_variable)[1] + if (!is.null(index) && !is.na(index) && length(index) > 0) selected_ix <- index + } - join_keys <- get_join_keys(data) - if (!is.null(join_keys)) { - icons[intersect(join_keys$get(dataset_name)[[dataset_name]], colnames(df))] <- "primary_key" - } - icons <- variable_type_icons(icons) - - # generate sparklines - sparklines_html <- vapply( - df, - create_sparklines, - FUN.VALUE = character(1), - USE.NAMES = FALSE - ) + # Retrieve the index of the first item of the current page + # it works with varying number of entries on the page (10, 25, ...) + table_id_sel <- paste0("variable_browser_", dataset_name, "_state") + dt_state <- shiny::isolate(input[[table_id_sel]]) + if (selected_ix != 1 && !is.null(dt_state)) { + selected_page_ix <- floor(selected_ix / dt_state$length) * dt_state$length + } - data.frame( - Type = icons, - Variable = names(labels), - Label = labels, - Missings = missings, - Sparklines = sparklines_html, - stringsAsFactors = FALSE - ) - } - }, - escape = FALSE, - rownames = FALSE, - selection = list(mode = "single", target = "row", selected = 1), - options = list( - fnDrawCallback = htmlwidgets::JS("function() { HTMLWidgets.staticRender(); }"), - pageLength = input[[paste0(table_ui_id, "_rows")]] + DT::datatable( + df_output, + escape = FALSE, + rownames = FALSE, + selection = list(mode = "single", target = "row", selected = selected_ix), + options = list( + fnDrawCallback = htmlwidgets::JS("function() { HTMLWidgets.staticRender(); }"), + pageLength = input[[paste0(table_ui_id, "_rows")]], + displayStart = selected_page_ix + ) ) - ) + }) } #' Creates observers updating the currently selected column diff --git a/man/render_tab_table.Rd b/man/render_tab_table.Rd index 5ec62c3a9..152860aa6 100644 --- a/man/render_tab_table.Rd +++ b/man/render_tab_table.Rd @@ -10,7 +10,8 @@ render_tab_table( output, data, input, - columns_names + columns_names, + plot_var ) } \arguments{ @@ -25,6 +26,8 @@ render_tab_table( \item{input}{(\code{session$input}) the shiny session input} \item{columns_names}{(\code{environment}) the environment containing bindings for each dataset} + +\item{plot_var}{(\code{list}) the list containing the currently selected dataset (tab) and its column names} } \description{ The table contains column names, column labels,