如何在R Shiny Dashboard中用reactable实现表格点击联动筛选

这个需求完全可行，核心是通过reactable的点击事件传递选中的球员名称，结合Shiny的交互API实现面板切换和数据筛选。具体实现步骤如下：

实现步骤 #

• 添加表格点击交互：在Table1的name列定义点击事件，通过JavaScript将选中的球员名称发送到Shiny的输入对象中
• 创建反应式状态：在Server端定义反应式变量，存储用户点击的球员名称
• 自动切换面板：监听点击事件，调用updateTabItems自动切换到Table2面板
• 筛选Table2数据：基于选中的球员名称，动态筛选Table2的数据源

修改后的完整代码 #

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

d1 <- 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)
)

d2 <- data.frame(
  name = c(
    "Frank", "Frank", "Frank",
    "Emma", "Emma", "Emma",
    "Kurt", "Kurt", "Kurt",
    "Johanna", "Johanna", "Johanna",
    "Anna", "Anna", "Anna",
    "Ben", "Ben", "Ben",
    "Chris", "Chris", "Chris",
    "David", "David", "David",
    "Eva", "Eva", "Eva",
    "Felix", "Felix", "Felix",
    "Gina", "Gina", "Gina",
    "Hannah", "Hannah", "Hannah",
    "Iris", "Iris", "Iris",
    "Jack", "Jack", "Jack",
    "Karen", "Karen", "Karen",
    "Leo", "Leo", "Leo",
    "Mia", "Mia", "Mia",
    "Nina", "Nina", "Nina",
    "Omar", "Omar", "Omar",
    "Paul", "Paul", "Paul"
  ),
  match = c(
    1, 2, 3,  # Frank
    1, 2, 3,  # Emma
    1, 2, 3,  # Kurt
    1, 2, 3,  # Johanna
    1, 2, 3,  # Anna
    1, 2, 3,  # Ben
    1, 2, 3,  # Chris
    1, 2, 3,  # David
    1, 2, 3,  # Eva
    1, 2, 3,  # Felix
    1, 2, 3,  # Gina
    1, 2, 3,  # Hannah
    1, 2, 3,  # Iris
    1, 2, 3,  # Jack
    1, 2, 3,  # Karen
    1, 2, 3,  # Leo
    1, 2, 3,  # Mia
    1, 2, 3,  # Nina
    1, 2, 3,  # Omar
    1, 2, 3   # Paul
  ),
  score = c(
    4, 4, 4,  # Frank (12)
    5, 5, 5,  # Emma (15)
    4, 4, 5,  # Kurt (13)
    4, 4, 5,  # Johanna (13)
    5, 4, 5,  # Anna (14)
    4, 4, 3,  # Ben (11)
    4, 3, 3,  # Chris (10)
    6, 5, 5,  # David (16)
    3, 3, 3,  # Eva (9)
    3, 3, 2,  # Felix (8)
    6, 6, 5,  # Gina (17)
    5, 5, 4,  # Hannah (14)
    4, 4, 4,  # Iris (12)
    4, 4, 5,  # Jack (13)
    5, 5, 5,  # Karen (15)
    6, 5, 5,  # Leo (16)
    4, 4, 3,  # Mia (11)
    4, 3, 3,  # Nina (10)
    3, 3, 3,  # Omar (9)
    3, 3, 2   # Paul (8)
  )
)

ui <- dashboardPage(
  dashboardHeader(title = "Test"),
  dashboardSidebar(
    sidebarMenu(id = "tabs", # 给侧边栏菜单加id，用于切换面板
      menuItem("Table 1", tabName = "table1", icon = icon("table")),
      menuItem("Table 2", tabName = "table2", icon = icon("table"))
    )
  ),
  dashboardBody(
    tabItems(
      tabItem(tabName = "table1",
              fluidRow(
                box(width = 12,
                    title = "Table 1",
                    reactableOutput("table1"))
              )
      ),
      tabItem(tabName = "table2",
              fluidRow(
                box(width = 12,
                    title = "Table 2",
                    reactableOutput("table2"))
              )
      )
    )
  )
)

server <- function(input, output, session) {
  # 定义反应式变量存储选中的球员名称
  selected_player <- reactiveVal(NULL)
  
  output$table1 <- renderReactable({
    reactable(
      d1,
      filterable = TRUE,
      columns = list(
        score = colDef(footer = JS(
          c(
            "function(column, state) {",
            "  let total = 0",
            "  state.sortedData.forEach(function(row) {",
            "    total += row[column.id] ",
            "  })",
            "  return total",
            "}"
          )
        )),
        name = colDef(
          footer = "Total",
          # 添加点击事件，将选中的名称发送给Shiny输入
          cell = JS("function(cellInfo) {
            return '<a href=\"#\" onclick=\"Shiny.setInputValue(\\'selected_name\\', \\'' + cellInfo.value + '\\');\">' + cellInfo.value + '</a>'
          }")
        )
      ),
      defaultSorted = "score",
      defaultSortOrder = "desc",
      defaultPageSize = 5
    )
  })
  
  # 监听选中的球员名称，切换面板并更新筛选状态
  observeEvent(input$selected_name, {
    selected_player(input$selected_name)
    # 切换到Table2面板
    updateTabItems(session, "tabs", "table2")
  })
  
  # 渲染筛选后的Table2
  output$table2 <- renderReactable({
    # 根据选中的球员筛选数据，未选中时显示全部
    filtered_data <- if (!is.null(selected_player())) {
      d2[d2$name == selected_player(), ]
    } else {
      d2
    }
    
    reactable(
      filtered_data,
      filterable = TRUE,
      columns = list(
        score = colDef(footer = JS(
          c(
            "function(column, state) {",
            "  let total = 0",
            "  state.sortedData.forEach(function(row) {",
            "    total += row[column.id] ",
            "  })",
            "  return total",
            "}"
          )
        )),
        name = colDef(footer = "Total")
      ),
      defaultSorted = "score",
      defaultSortOrder = "desc",
      defaultPageSize = 5
    )
  })
}

shinyApp(ui, server)

代码说明 #

1. 给侧边栏菜单添加id="tabs"，用于updateTabItems定位切换目标
2. 在Table1的name列通过cell参数定义点击事件，用Shiny.setInputValue将选中名称传递到Shiny输入input$selected_name
3. 用observeEvent监听input$selected_name，更新反应式变量并调用updateTabItems切换到Table2面板
4. Table2基于反应式变量selected_player()动态筛选数据源，未选中时显示全部数据

内容的提问来源于stack exchange，提问作者Gurkenhals