rshinyreactable

How to extract filtered data from a reactable table?


In an R Shiny dashboard, I can display data from a dataframe in a table using the reactable package. The table includes filter options that allow the displayed observations to be restricted. Now, I would like to display a density plot in a second tab, using the Score column from the reactable table as the data source. When the filters in the reactable table are adjusted, the data basis of the density plot should change accordingly, and the plot should update.

To achieve this, I believe it is necessary to extract the filtered data from the reactable table as a dataframe in the server section where output$plot is defined. Is this possible, and if so, how can it be done? So far, I haven't found a way to do this. Below is a working example. The line filted_d <- d is a placeholder to allow the plot to be displayed.

library(shiny)
library(shinydashboard)
library(reactable)
library(ggplot2)

d <- data.frame(
  name = c("Frank", "Emma", "Kurt", "Johanna", "Anna", "Ben", "Chris", "David", "Eva", "Felix", "Gina", "Hannah", "Iris", "Jack", "Karen", "Leo", "Mia", "Nina", "Omar", "Paul"),
  team = c("A", "A", "B", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"),
  score = c(12, 15, 13, 13, 14, 11, 10, 16, 9, 8, 17, 14, 12, 13, 15, 16, 11, 10, 9, 8)
)

ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(
    sidebarMenu(
      id = "tabs",
      menuItem("Table", tabName = "table", icon = icon("table")),
      menuItem("Plot", tabName = "plot", icon = icon("plot"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "table",
              fluidRow(
                box(width = 12,
                    title = "Table",
                    reactableOutput("table"))
              )
      ),
      tabItem(tabName = "plot",
              fluidRow(
                box(width = 12,
                    title = "Plot",
                    plotOutput("plot", height = "500px"))  # Höhe des Plots erhöhen
              )
      )
    )
  )
)

server <- function(input, output, session) {
  
  output$table <- renderReactable({
    reactable(
      d,
      filterable = TRUE,
      columns = list(
        score = colDef(
          footer = function(values) sum(values, na.rm = TRUE)
        ),
        name = colDef(footer = "Total")
      ),
      defaultSorted = "score",
      defaultSortOrder = "desc",
      defaultPageSize = 5
    )
  })
  
  output$plot <- renderPlot({
    filted_d <- d ## Question: How can I get only the filtered data in the reactable table here?
    
    
    # Calculate the number and percentage of values used
    total_values <- nrow(d)
    filtered_values <- nrow(filted_d)
    used_percentage <- round((filtered_values / total_values) * 100, 2)
    
    # Create the density plot
    ggplot(filted_d, aes(x = score)) +
      geom_density(fill = "blue") +
      labs(
        title = paste0("Plot uses ", filtered_values, " (", used_percentage, "%) of ", total_values, " observations.")
      ) +
      theme_classic()
  })
  
}

shinyApp(ui, server)

Solution

  • Here is a working example using the Reactable Javascript API to get the current state of the table (with Reactable.getState()). The generated object can be sent to Shiny with Shiny.setInputValue(), and the filtered/sorted data can be accessed in the $sortedData attribute of the object (as a list, so we can then obtain a dataframe with rbindlist).

    library(shiny)
    library(shinydashboard)
    library(reactable)
    library(ggplot2)
    
    d <- data.frame(
      name = c("Frank", "Emma", "Kurt", "Johanna", "Anna", "Ben", "Chris", "David", "Eva", "Felix", "Gina", "Hannah", "Iris", "Jack", "Karen", "Leo", "Mia", "Nina", "Omar", "Paul"),
      team = c("A", "A", "B", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B", "A", "B"),
      score = c(12, 15, 13, 13, 14, 11, 10, 16, 9, 8, 17, 14, 12, 13, 15, 16, 11, 10, 9, 8)
    )
    
    ui <- dashboardPage(
      dashboardHeader(title = "Test"),
      dashboardSidebar(
        sidebarMenu(
          id = "tabs",
          menuItem("Table", tabName = "table", icon = icon("table")),
          menuItem("Plot", tabName = "plot", icon = icon("plot"))
        )
      ),
      dashboardBody(
        tabItems(
          tabItem(tabName = "table",
                  fluidRow(
                    box(width = 12,
                        title = "Table",
                        reactableOutput("tbl"),
                        verbatimTextOutput("tbl_state")
                        )
                  )
          ),
          tabItem(tabName = "plot",
                  fluidRow(
                    box(width = 12,
                        title = "Plot",
                        plotOutput("plot", height = "500px"))  # Höhe des Plots erhöhen
                  )
          )
        )
      )
    )
    
    server <- function(input, output, session) {
    
      output$tbl <- renderReactable({
        tbl <- reactable(
          d,
          filterable = TRUE,
          columns = list(
            score = colDef(
              footer = function(values) sum(values, na.rm = TRUE)
            ),
            name = colDef(footer = "Total")
          ),
          defaultSorted = "score",
          defaultSortOrder = "desc",
          defaultPageSize = 5
        )
    
        htmlwidgets::onRender(tbl, "() => {
          Reactable.onStateChange('tbl', state => {
            Shiny.setInputValue('tbl_state', Reactable.getState('tbl'))
          })
        }")
      })
    
    
    output$tbl_state <- renderPrint({
      t_state <- input$tbl_state
      writeLines("Filtered table:\n")
      print(rbindlist(t_state$sortedData))
    })
    
      output$plot <- renderPlot({
    
        t_state <- input$tbl_state
        filtered_data <- rbindlist(t_state$sortedData)
    
        # Calculate the number and percentage of values used
        total_values <- nrow(d)
        filtered_values <- nrow(filtered_data)
        used_percentage <- round((filtered_values / total_values) * 100, 2)
    
        # Create the density plot
        ggplot(filtered_data, aes(x = score)) +
          geom_density(fill = "blue") +
          labs(
            title = paste0("Plot uses ", filtered_values, " (", used_percentage, "%) of ", total_values, " observations.")
          ) +
          theme_classic()
      })
    
    }
    
    shinyApp(ui, server)