Render "expand details" only when clicking rt-expander-button

[algo-se]

Hi,

In a Shiny app, for some cases you can use JS to speed up the rendering of some elements of the table, but for complex details (like full reactable tables) JS gets harder to implement. Would it be possible to adapt the CRAN Packages demo so that the details get rendered only when expanding the corresponding row?

Maybe using a combination of observeEvent and eventReactive, but how can you identify the index of the row the user is clicking to render only the details of that row?

Best regards.

[glin]

If I understand correctly, I think that's possible. You can have the row details render some Shiny output or uiOutput() with an ID that includes the row index (which comes from the render function), then create your Shiny outputs based on row indices.

For example, here's an example app I made for a previous issue. It renders a nested table for each row detail, but the output for that nested table doesn't run until you've expanded the row.

library(shiny)
library(reactable)
library(htmltools)

data <- unique(CO2[, c("Plant", "Type")])

ui <- fluidPage(
  reactable(data, details = function(index) {
    div(style = "padding: 16px",
        reactableOutput(paste0("tbl-", index))
    )
  })
)

server <- function(input, output) {
  lapply(seq_len(nrow(data)), function(index) {
    output[[paste0("tbl-", index)]] <- renderReactable({
      plant_data <- CO2[CO2$Plant == data$Plant[index], ]
      reactable(plant_data,
                selection = "multiple",
                onClick = "select",
                outlined = TRUE)
    })
  })

  observe({
    # Print selected rows for the nested table in row 1
    print(getReactableState("tbl-1", "selected"))
  })
}

shinyApp(ui, server)

The downside is that it's a little clunky to programmatically create outputs in Shiny. You need to create them with something like lapply instead of a for loop to avoid the issue with all outputs using the same index.

[algo-se]

Hi @glin, thank you so much for the idea.

What if the data in your example is a reactive dataframe? Is there another way to avoid the rendering of the details when starting the shiny app in that case?

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

server <- function(input, output) {
  output$table <- renderReactable({
    reactable(
      data_reactive(),
      details = function(index) {
        plant_data <- CO2[CO2$Plant == data$Plant[index], ]
        div(style = "padding: 16px",
          plant_data)}
    )
  })
}

[glin]

With a reactive dataframe, you could still use the same technique of rendering Shiny outputs as the row details. Shiny outputs only run when visible, so they won't be run until the user expands a row.

[algo-se]

With a reactive dataframe, you could still use the same technique of rendering Shiny outputs as the row details.

I've been thinking about this but I might be missing something because I fail to see how to do this.

If you have a reactive dataframe, you have to use renderReactable in the server, but then you can´t use reactableOutput inside that render function, right?

library(shiny)
library(reactable)
library(htmltools)

data <- unique(CO2[, c("Plant", "Type")])

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

server <- function(input, output) {

  data_rv <- reactive(data)

  lapply(seq_len(nrow(data_rv())), function(index) {
    output[[paste0("tbl-", index)]] <- renderReactable({
      plant_data <- CO2[CO2$Plant == data$Plant[index], ]
      reactable(plant_data,
                selection = "multiple",
                onClick = "select",
                outlined = TRUE)
    })
  })

  output$table <- renderReactable({
    reactable(data, details = function(index) {
      div(style = "padding: 16px",
          reactableOutput(paste0("tbl-", index))  # can´t do this afaik
      )
    })
  })
}

shinyApp(ui, server)

[glin]

Oh I misunderstood, thanks for posting that example. In that case, yeah, it's a lot tougher, and I think having a dynamic number of outputs is just something that's generally hard to do in Shiny.

If your reactive data is a single dataset that gets filtered, you could potentially create one Shiny output per row, identified by some unique ID rather than row index. For example, here's an app that uses a reactive data frame that can be filtered:

library(shiny)
library(reactable)
library(htmltools)

data <- unique(CO2[, c("Plant", "Type")])

data$id <- seq_len(nrow(data))

ui <- fluidPage(
  selectInput("filter_type", "Filter Type", c("All", "Quebec", "Mississippi")),
  reactableOutput("table")
)

server <- function(input, output) {

  data_rv <- reactive({
    if (input$filter_type == "All") {
      data
    } else {
      data[data$Type == input$filter_type, ]
    }
  })

  lapply(seq_len(nrow(data)), function(index) {
    id <- data[index, "id"]
    output[[paste0("tbl-", id)]] <- renderReactable({
      plant_data <- CO2[CO2$Plant == data$Plant[data$id == id], ]
      reactable(plant_data,
                selection = "multiple",
                onClick = "select",
                outlined = TRUE)
    })
  })

  output$table <- renderReactable({
    tbl_data <- data_rv()[, c("Plant", "Type")]
    reactable(tbl_data, details = function(index) {
      id <- data_rv()[index, "id"]
      div(style = "padding: 16px",
          reactableOutput(paste0("tbl-", id))
      )
    })
  })
}

shinyApp(ui, server)

If your reactive data can be different datasets, this could still be possible but just messier. But in that case, I think I would consider moving away from nested Shiny outputs, and use a separate UI element to show row details, based on selected row or something. Then you'd have one fixed Shiny output that displays whatever is selected at the time. As a really simple example:

library(shiny)
library(reactable)
library(htmltools)

data <- unique(CO2[, c("Plant", "Type")])

ui <- fluidPage(
  selectInput("filter_type", "Filter Type", c("All", "Quebec", "Mississippi")),
  reactableOutput("table"),
  tags$details(
    tags$summary("Details", style = "display: list-item"),
    reactableOutput("details")
  )
)

server <- function(input, output) {

  data_rv <- reactive({
    if (input$filter_type == "All") {
      data
    } else {
      data[data$Type == input$filter_type, ]
    }
  })

  output$table <- renderReactable({
    tbl_data <- data_rv()[, c("Plant", "Type")]
    reactable(tbl_data, selection = "single", onClick = "select")
  })

  output$details <- renderReactable({
    selected <- getReactableState("table", "selected")
    req(selected)
    plant <- data_rv()[selected, "Plant"]
    plant_data <- CO2[CO2$Plant == plant, ]
    reactable(plant_data,
              selection = "multiple",
              onClick = "select",
              outlined = TRUE)
  })
}

shinyApp(ui, server)

[algo-se]

Thank you for the help @glin, your first option is perfect!

I really like this idea though:

  reactableOutput("table"),
  tags$details(
    tags$summary("Details", style = "display: list-item"),
    reactableOutput("details")
  )

Keeping things simple in Shiny is always good 😛

[gofford]

@glin In this example:

library(shiny)
library(reactable)
library(htmltools)

data <- unique(CO2[, c("Plant", "Type")])

ui <- fluidPage(
  selectInput("filter_type", "Filter Type", c("All", "Quebec", "Mississippi")),
  reactableOutput("table"),
  tags$details(
    tags$summary("Details", style = "display: list-item"),
    reactableOutput("details")
  )
)

server <- function(input, output) {

  data_rv <- reactive({
    if (input$filter_type == "All") {
      data
    } else {
      data[data$Type == input$filter_type, ]
    }
  })

  output$table <- renderReactable({
    tbl_data <- data_rv()[, c("Plant", "Type")]
    reactable(tbl_data, selection = "single", onClick = "select")
  })

  output$details <- renderReactable({
    selected <- getReactableState("table", "selected")
    req(selected)
    plant <- data_rv()[selected, "Plant"]
    plant_data <- CO2[CO2$Plant == plant, ]
    reactable(plant_data,
              selection = "multiple",
              onClick = "select",
              outlined = TRUE)
  })
}

shinyApp(ui, server)

it's pretty straightforward to update output$details so that the rendered data is pulled in from an external source or database, e.g.,

output$details <- renderReactable({
    selected <- getReactableState("table", "selected")
    req(selected)
    data <- get_data_from_database(selected)
    reactable(data, outlined = TRUE)
  })

Is there a way to have this same (or similar) code block embedded as a nested row with details? Use-case is for a user to expand a row in a "main" aggregated table to pull in more granular data as and when required. There is too much data to throw at the user browser all at once. As far as I can tell all of the code in details is executed when the table is rendered, which fires off all of the queries on-load which is not desired. Is there a workaround?

On further digging I'm assuming that is affected by the same behaviour alluded to here? https://github.com/glin/reactable/issues/17#issuecomment-568219147

[algo-se]

Hey @gofford, in the example you quoted, the user would only see the details of the selected row. When the "main" table is first rendered, there is no row selected, so details is not executed. Apologies if I'm missing something ^^

Actually, this example is the one I ended up using in production, but instead of using tags$details, I just used another box where I put the "details" reactable.