How do I ensure reactable::getReactableState() returns the correct row selection in a Shiny app when table is regenerated?

I have a Shiny app (please see end for a minimum working example) with a "parent" reactable table and a drilldown table that pops up when a user clicks on a row of the parent table. The information on which row is selected in the parent is obtained via reactable::getReactableState(). However, when the user switches to a different "parent" table, the function returns the row selection for the outdated table, not the updated one.

This occurs event though the output for the new parent table has completed it's calculations and is fully updated by the time the drilldown table starts it's calculations. After the whole systems finished and the app is idle, something (and I'm not sure what) triggers the input to reactable::getReactableState() to be invalidated, and the reactives fire again, but this time using the updated (or "correct" from my perspective) tables, and returns the expected result, which is that now row is selected.

Referring to the reactive graph below, what I want to do is have input$tables-table_parent__reactable__selected set not NULL every time input$tables-data_set changes.

I have tried to do this via the session$sendCustomMessage() and Shiny.addCustomMessageHandler approach found here: Change the input value in shiny from server, but I find that, although I can change input$tables-table_parent__reactable__selected value it doesn't seem to send send the info to the browser until after all the outputs are done caculating when input$tables-data_set is changed.

A minimum working example:

UI module:

drilldownUI <- function(id) {
  ns <- NS(id)
  tagList(
      tags$script("
      Shiny.addCustomMessageHandler('tables-table_parent__reactable__selected', function(value) {
      Shiny.setInputValue('tables-table_parent__reactable__selected', value);
      });
    "),
    shiny::selectizeInput(
      inputId = ns("data_set"),
      label = "Data set",
      choices = c("iris", "cars"),
      selected = "iris"
    ),
    reactable::reactableOutput(outputId = ns("table_parent"),
                               width = "100%"),

    reactable::reactableOutput(
      outputId = NS(id, "drilldown_table"),
      width = "100%"
    )
  )
}

Server module:

drilldownServer <- function(id, dat) {
  moduleServer(id, function(input, output, session) {
    dataset <- reactive({
      data_list <-
        list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
      data_list[[input$data_set]]
    })
 data_grouped <- reactive({
      dataset()[, .N, by = c(grouping_var())]
    })
    grouping_var <- reactive({
      if (input$data_set == "iris") {
        return("Species")
      }
      "Origin"
    })

    output$table_parent <- reactable::renderReactable({
      req(input$data_set)
      reactable::reactable(
        data_grouped(),
        selection = "single",
        onClick = "select"
      )
    })

    selected <- reactive({
      out <- reactable::getReactableState("table_parent", "selected")

      if(is.null(out)||out=="NULL") return(NULL)
      out
    })

    output$drilldown_table <- reactable::renderReactable({
      req(selected())

# This should only fire after a new parent table is generated and the row selection is
# reset to NULL, but it fires once the new table is generated and BEFORE the row selection
# is reset to NULL

      selected_group <- data_grouped()[selected(), ][[grouping_var()]]
      drilldown_data <- dataset()[get(grouping_var()) == selected_group]
      reactable::reactable(drilldown_data)
    })

    observeEvent(input$data_set, {
      session$sendCustomMessage("tables-table_parent__reactable__selected", 'NULL')
    })


  })

App:

library(shiny)
library(reactable)
library(data.table)
# Define UI for application that draws a histogram
ui <- fluidPage(
    drilldownUI("tables")
)

# Define server logic required to draw a histogram
server <- function(input, output) {
   drilldownServer("tables")
}

# Run the application
shinyApp(ui = ui, server = server)

Solution

I found the solution thanks in part to this SO answer https://stackoverflow.com/a/39440482/9474704.

The key was to consider the row selection a state, rather than just reacting to input changes. Then, by using reactiveValues() instead of reactive(), I could update the state in multiple places using observeEvent().

An important additonal piece of information was that observe functions are eager, and you can set a priority, so when the user changes the input$data_set, I could reset the row selection to 0 before the drilldown reactable::renderReactable() section was evaluated.

The updates to the server module below for an example of the working solution:

drilldownServer <- function(id, dat) {
  moduleServer(id, function(input, output, session) {
    dataset <- reactive({
      data_list <-
        list(iris = as.data.table(iris), cars = as.data.table(MASS::Cars93))
      data_list[[input$data_set]]
    })

    data_grouped <- reactive({
      dataset()[, .N, by = c(grouping_var())]
    })

    grouping_var <- reactive({
      if (input$data_set == "iris") {
        return("Species")
      }
      "Origin"
    })

    # Create output for parent table
    output$table_parent <- reactable::renderReactable({
      req(input$data_set)

      reactable::reactable(data_grouped(),
                           selection = "single",
                           onClick = "select")
    })

    # Create state variable
    selected <- reactiveValues(n = 0)

    currentSelected <- reactive({
      reactable::getReactableState("table_parent", "selected")
    })

    observeEvent(currentSelected(), priority = 0, {
      selected$n <- currentSelected()
    })

    # When data set input changes, set the selected number of rows to 0e
    observeEvent(input$data_set,
                 label = "reset_selection",
                 priority = 9999, {
                   selected$n <- 0
                 })


    # Create output for drilldown table
    output$drilldown_table <- reactable::renderReactable({
      req(selected$n > 0)
      selected_group <-
        data_grouped()[selected$n, ][[grouping_var()]]
      drilldown_data <-
        dataset()[get(grouping_var()) == selected_group]
      reactable::reactable(drilldown_data)
    })
  })
}