Add "clicked" state to Shiny reactives

[gadenbuie]

I've made a few apps that use a reactable table with additional filters and select input controls for filtering a common data set. This gives finer-grained control over the filtering controls but it has a significant drawback when trying to capture a "stack" of selected rows from the parent data set.

If reactable provided a clicked reactive value, e.g. via getReactableState("table", "clicked"), that returns the index of the most recently clicked row, I could do the following:

1. Initialize a global stack of selected rows
2. When a user clicks a row, it is added or removed from the global stack and the selected rows in the table is updated with updateReactable()
3. When the user updates the filters, the table is updated using the selected rows in both the new view and the global stack.

Currently, the way that I have been implementing this is to watch getReactableState("table", "selected"). But because this returns all selected rows in the current view, I have to track this value at each reactive iteration to find out which row was added or removed.

It would be much simpler to be able to watch an event stream, which can almost be accomplished using the onClick argument with a custom event handler. The problem there is that click events on the select checkboxes aren't propagated so the onClick action won't fire when the checkbox is clicked. The way around that is to fall back on the above approach to watch changes in "selected" or to hand-roll a new column to track selected state.

(BTW, this would be equivalent to the _last_clicked Shiny reactive event in DT https://rstudio.github.io/DT/shiny.html#row-selection)

[glin]

Hmm, would a "last selected" value from getReactableState() be useful? Something that lets you get just the most recently selected rows. A "clicked" row state wouldn't exactly be the same, since you could click a single grouped row to select multiple rows at once. Or you could programmatically select a row on a different page that can't be clicked using updateReactable().

Do you have a code example of what you're describing, or a link to one of the apps? That would help me understand the problem better. I'm imagining an app like this, but I don't totally get where the filters come in:

library(reactable)
library(shiny)

ui <- fluidPage(
  reactableOutput("tbl")
)

server <- function(input, output) {
  output$tbl <- renderReactable({
    reactable(mtcars, selection = "multiple", onClick = "select")
  })

  prev_selected <- reactiveVal()

  observe({
    selected <- getReactableState("tbl", "selected")
    if (length(selected) > length(prev_selected())) {
      message("last selected: ", paste(setdiff(selected, prev_selected()), collapse = ", "))
    } else if (length(selected) < length(prev_selected())) {
      message("last deselected: ", paste(setdiff(prev_selected(), selected), collapse = ", "))
    }
    prev_selected(selected)
  })
}

shinyApp(ui, server)

[gadenbuie]

Here's a simple motivating example. I have a common data set with filtering controls in the UI. Adjusting the filters shows a subset of rows in the reactable, but the external filtering inputs give a lot more control over the UI than the column-level filters provided by reactable.

In the app below, I'm using mtcars as the common data set, but I have an external selectizeInput() that I'm using to filter the table on the cyl column. If I filter to cyl of 6 and select a row, that selection will be lost when I update the table. If, on the other hand, I were to filter a column using the column heading filters, like disp, when you clear the filter the selection state is maintained.

Maintaining persistent row selection across filtered views in reactable is tedious, especially since it's complicated by shiny's reactivity. This problem becomes trivial if I can use an event that reports the last clicked row. You can see a complete worked example in this app (source code).

After thinking about this a bit more, I think another approach would be to allow users to hook into the filtering logic. If I could instead provide a list of row indices to filter in or out from the R side, I could let reactable handle all of the selection. I hadn't considered grouped rows originally, and maybe this approach would be more robust.

library(shiny)
library(reactable)

mtcars <- tibble::rownames_to_column(mtcars, "make_model")
mtcars <- tibble::as_tibble(mtcars)

ui <- fluidPage(
  h2("Filter"),
  selectizeInput(
    "cyl",
    "Cylinders",
    choices = unique(mtcars$cyl),
    selected = NULL,
    multiple = TRUE
  ),
  h2("Selection"),
  verbatimTextOutput("selection"),
  h2("Table"),
  reactableOutput("table")
)

server <- function(input, output, session) {
  data_filtered <- reactive({
    if (isTruthy(input$cyl)) {
      mtcars[mtcars$cyl %in% input$cyl, ]
    } else {
      mtcars
    }
  })

  output$table <- renderReactable({
    reactable(data_filtered(), selection = "multiple", onClick = "select", filterable = TRUE)
  })

  output$selection <- renderPrint({
    reactable::getReactableState("table")
  })
}

shinyApp(ui, server)

[glin]

After thinking about this a bit more, I think another approach would be to allow users to hook into the filtering logic. If I could instead provide a list of row indices to filter in or out from the R side, I could let reactable handle all of the selection.

I like this a lot. Row selection state is intentionally reset on data changes because there's no guarantee that the new dataset is the same, and it won't make sense to persist a row-index-based selection in many cases. The nicer way would be to use the table's built-in filtering, but there's no way to programmatically filter a table from Shiny. I've been thinking of adding the filter values to updateReactable()/getReactableState() for the next release, so maybe there will be a way to do this soon-ish.

For now, the only way to filter tables from an external input would be using Crosstalk. If you can use Crosstalk, external filtering could look something like this:

library(shiny)
library(reactable)
library(crosstalk)

mtcars <- tibble::rownames_to_column(mtcars, "make_model")
mtcars <- tibble::as_tibble(mtcars)
shared_mtcars <- SharedData$new(mtcars)

ui <- fluidPage(
  h2("Filter"),
  filter_select("cyl", "Cylinders", shared_mtcars, ~cyl),
  h2("Selection"),
  verbatimTextOutput("selection"),
  h2("Table"),
  reactableOutput("table")
)

server <- function(input, output, session) {
  output$table <- renderReactable({
    reactable(shared_mtcars, selection = "multiple", onClick = "select", filterable = TRUE)
  })

  output$selection <- renderPrint({
    reactable::getReactableState("table")
  })
}

shinyApp(ui, server)