Merge pull request #1909 from jonthegeek/selection

Allow selection in interactive tables

NAMESPACE

@@ -157,6 +157,7 @@ export(gt_latex_dependencies)
 export(gt_output)
 export(gt_preview)
 export(gt_split)
+export(gt_update_select)
 export(gtsave)
 export(html)
 export(info_currencies)

NEWS.md

@@ -1,5 +1,9 @@
 # gt (development version)
 
+* Interactive tables can support selection through the `ihtml.selection_mode` option. (@jonthegeek, #1909)
+
+* Tables embedded in Shiny apps with `gt_output()` and `render_gt()` with `ihtml.selection_mode` enabled also act as inputs, reporting the row numbers that are selected (#354, #1368). (@jonthegeek, #1909)
+
 # gt 0.11.1
 
 ## Breaking changes

R/dt_options.R

@@ -256,6 +256,7 @@ dt_options_tbl <-
     "ihtml_page_size_default",           FALSE,  "interactive",      "values",  10,
     "ihtml_page_size_values",            FALSE,  "interactive",      "values",  default_page_size_vec,
     "ihtml_pagination_type",             FALSE,  "interactive",      "value",   "numbers",
+    "ihtml_selection_mode",              FALSE,  "interactive",      "value",   NA_character_,
     "page_orientation",                  FALSE,  "page",             "value",   "portrait",
     "page_numbering",                    FALSE,  "page",             "logical", FALSE,
     "page_header_use_tbl_headings",      FALSE,  "page",             "logical", FALSE,

R/opts.R

@@ -220,6 +220,7 @@ get_colorized_params <- function(
 #' - `ihtml.page_size_values`
 #' - `ihtml.pagination_type`
 #' - `ihtml.height`
+#' - `ihtml.selection_mode`
 #'
 #' @inheritParams fmt_number
 #'
@@ -337,6 +338,17 @@ get_colorized_params <- function(
 #'
 #'   Height of the table in pixels. Defaults to `"auto"` for automatic sizing.
 #'
+#' @param selection_mode *Allow row selection*
+#'
+#'    `scalar<character>` // *default:* `NULL`
+#'
+#'    The `selection_mode` options allows users to select rows by clicking them.
+#'    When this option is `"single"`, clicking another value toggles selection
+#'    of the previously selected row off. When this option is `"multiple"`,
+#'    multiple rows can be selected at once. Selected values are available in
+#'    Shiny apps when `selection_mode` is not `NULL` and the table is used in
+#'    [render_gt()].
+#'
 #' @return An object of class `gt_tbl`.
 #'
 #' @section Examples:
@@ -418,13 +430,14 @@ opt_interactive <- function(
     page_size_default = 10,
     page_size_values = c(10, 25, 50, 100),
     pagination_type = c("numbers", "jump", "simple"),
-    height = "auto"
+    height = "auto",
+    selection_mode = NULL
 ) {
 
   # Perform input object validation
   stop_if_not_gt_tbl(data = data)
 
-  pagination_type <- 
+  pagination_type <-
     rlang::arg_match0(pagination_type, values = c("numbers", "jump", "simple"))
 
   tab_options(
@@ -443,7 +456,8 @@ opt_interactive <- function(
     ihtml.page_size_default = page_size_default,
     ihtml.page_size_values = page_size_values,
     ihtml.pagination_type = pagination_type,
-    ihtml.height = height
+    ihtml.height = height,
+    ihtml.selection_mode = selection_mode
   )
 }
 
@@ -1457,11 +1471,11 @@ opt_table_outline <- function(
 #'   A name that is representative of a font stack (obtained via internally via
 #'   the [system_fonts()] helper function). If provided, this new stack will
 #'   replace any defined fonts and any `font` values will be prepended.
-#' 
+#'
 #' @param size *Text size*
-#' 
+#'
 #'   `scalar<character|numeric|integer>` // *default:* `NULL` (`optional`)
-#' 
+#'
 #'   The text size for the entire table can be set by providing a `size` value.
 #'   Can be specified as a single-length character vector with units of pixels
 #'   (e.g., `12px`) or as a percentage (e.g., `80%`). If provided as a
@@ -1484,11 +1498,11 @@ opt_table_outline <- function(
 #'   `"normal"`, `"bold"`, `"lighter"`, `"bolder"`, or, a numeric value between
 #'   `1` and `1000`, inclusive. Please note that typefaces have varying support
 #'   for the numeric mapping of weight.
-#' 
+#'
 #' @param color *Text color*
-#' 
+#'
 #'   `scalar<character>` // *default:* `NULL` (`optional`)
-#' 
+#'
 #'   The `color` option defines the text color used throughout the table. A
 #'   color name or a hexadecimal color code should be provided.
 #'

R/render_as_i_html.R

@@ -188,6 +188,9 @@ render_as_ihtml <- function(data, id) {
   page_size_default <- tbl_opts$ihtml_page_size_default
   page_size_values <- tbl_opts$ihtml_page_size_values
   pagination_type <- tbl_opts$ihtml_pagination_type
+  selection_mode <- tbl_opts$ihtml_selection_mode
+  if (is.na(selection_mode)) selection_mode <- NULL
+  onClick <- if (!is.null(selection_mode)) "select"
 
   use_row_striping <- tbl_opts$row_striping_include_table_body
   row_striping_color <- tbl_opts$row_striping_background_color
@@ -683,10 +686,10 @@ render_as_ihtml <- function(data, id) {
       paginateSubRows = FALSE,
       details = NULL,
       defaultExpanded = expand_groupname_col,
-      selection = NULL,
+      selection = selection_mode,
       selectionId = NULL,
       defaultSelected = NULL,
-      onClick = NULL,
+      onClick = onClick,
       highlight = use_highlight,
       outlined = FALSE,
       bordered = FALSE,

R/shiny.R

@@ -36,7 +36,11 @@
 #' holding the **gt** table. The `width` and `height` arguments allow for sizing
 #' the container, and the `align` argument allows us to align the table within
 #' the container (some other fine-grained options for positioning are available
-#' in [tab_options()]).
+#' in [tab_options()]). If the table is interactive, the selected row indices
+#' (relative to the underlying data, regardless of sorting) are available as
+#' `input$id`, where `id` is the `outputId` used for this table in [gt_output()].
+#' If the user has deselected all rows, the value is `0` (vs `NULL` when the
+#' table initializes).
 #'
 #' @param expr *Expression*
 #'
@@ -175,7 +179,11 @@ render_gt <- function(
           table.align = align
         )
 
-      html_tbl <- as.tags(result)
+      html_tbl <- htmltools::tagList(
+        as.tags(result),
+        shiny_deps(),
+        initialize_shiny_gt(name)
+      )
 
       dependencies <-
         lapply(
@@ -194,6 +202,22 @@ render_gt <- function(
   )
 }
 
+shiny_deps <- function() {
+  htmltools::htmlDependency(
+    "gtShiny",
+    "1.0.0",
+    src = "shiny",
+    package = "gt",
+    script = "gtShiny.js"
+  )
+}
+
+initialize_shiny_gt <- function(id) {
+  htmltools::HTML(
+    glue::glue("<script>gtShinyBinding.initialize('{id}');</script>")
+  )
+}
+
 # gt_output() ------------------------------------------------------------------
 #' Create a **gt** display table output element for Shiny
 #'
@@ -264,7 +288,45 @@ gt_output <- function(outputId) {
   # Ensure that the shiny package is available
   rlang::check_installed("shiny", "to use `gt_output()`.")
 
-  shiny::htmlOutput(outputId)
+  shiny::htmlOutput(outputId, class = "gt_shiny")
+}
+
+# gt_update_select() -----------------------------------------------------------
+#' Update a **gt** selection in Shiny
+#'
+#' @description
+#'
+#' Update the selection in an interactive **gt** table rendered using
+#' [render_gt()]. The table must be interactive and have selection enabled (see
+#' [opt_interactive()]).
+#'
+#' @param outputId *Shiny output ID*
+#'
+#'   `scalar<character>` // **required**
+#'
+#'   The id of the [gt_output()] element to update.
+#' @param rows *Row indices*
+#'
+#'   `<integer>` // **required**
+#'
+#'   The id of the [gt_output()] element to update.
+#' @param session *Shiny session*
+#'
+#'   `scalar<ShinySession>` // **required**
+#'
+#'   The session in which the [gt_output()] element can be found. You almost
+#'   certainly want to leave this as the default value.
+#'
+#' @return A call to the JavaScript binding of the table.
+#' @family Shiny functions
+#' @section Function ID:
+#' 12-3
+#'
+#' @export
+gt_update_select <- function(outputId,
+                             rows,
+                             session = shiny::getDefaultReactiveDomain()) {
+  session$sendInputMessage(outputId, rows - 1)
 }
 
 #nocov end

R/tab_options.R

@@ -455,6 +455,15 @@
 #'
 #'   Height of the table in pixels. Defaults to `"auto"` for automatic sizing.
 #'
+#' @param ihtml.selection_mode *Allow row selection*
+#'
+#'   For interactive HTML output, this allows users to select rows by clicking
+#'   them. When this option is `"single"`, clicking another value toggles
+#'   selection of the previously selected row off. When this option is
+#'   `"multiple"`, multiple rows can be selected at once. Selected values are
+#'   available in Shiny apps when `ihtml.selection_mode` is not `NULL` and the
+#'   table is used in [render_gt()].
+#'
 #' @param page.orientation *Set RTF page orientation*
 #'
 #'   For RTF output, this provides two options for page
@@ -838,6 +847,7 @@ tab_options <- function(
     ihtml.page_size_values = NULL,
     ihtml.pagination_type = NULL,
     ihtml.height = NULL,
+    ihtml.selection_mode = NULL,
     page.orientation = NULL,
     page.numbering = NULL,
     page.header.use_tbl_headings = NULL,
@@ -1034,6 +1044,20 @@ set_super_options <- function(arg_vals) {
       )
   }
 
+  if ("ihtml.selection_mode" %in% names(arg_vals)) {
+    ihtml_selection_mode_val <- arg_vals$ihtml.selection_mode
+    if (
+        !(
+          rlang::is_scalar_character(ihtml_selection_mode_val) &&
+          ihtml_selection_mode_val %in% c("single", "multiple")
+        )
+    ) {
+      cli::cli_abort(c(
+        "The chosen option for `ihtml.selection_mode` (`{ihtml_selection_mode_val}`) is invalid.",
+        "*" = "We can use either \"single\" or \"multiple\"."
+      ))
+    }
+  }
   arg_vals
 }