如何从可反应表中提取过滤后的数据？

Question

在 R Shiny 仪表板中，我可以使用可反应包在表中显示数据帧中的数据。该表包含允许限制显示的观察结果的过滤器选项。现在，我想使用可反应表中的“分数”列作为数据源，在第二个选项卡中显示密度图。当调整可反应表中的过滤器时，密度图的数据基础应相应改变，并且图应更新。

为了实现这一目标，我认为有必要从可反应表中提取过滤后的数据作为定义

output$plot

的服务器部分中的数据帧。这可能吗？如果可以，该怎么做？到目前为止，我还没有找到一种方法来做到这一点。下面是一个工作示例。

filted_d <- d

行是一个占位符，用于显示绘图。

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)

Answer 1

这是一个使用 Reactable Javascript API 获取表的当前状态的工作示例（使用

Reactable.getState()

）。生成的对象可以使用

Shiny.setInputValue()

发送到 Shiny，并且可以在对象的

$sortedData

属性中访问过滤/排序的数据（作为列表，因此我们可以使用

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)