Shiny中将DT单元格值传入自定义函数出现filter报错如何解决？

错误根因 #

报错本质上有两个核心问题：

• DT组件返回的单元格选中变量input$table1_cells_selected是两列矩阵，分别对应选中单元格的行索引、列索引，直接用该变量索引数据框会返回空值，导致dplyr::filter的判断条件长度为0，触发尺寸不匹配报错
• 未添加执行依赖判断，初始化或未选中任何单元格时，生成table2的响应式逻辑会直接运行，此时没有合法的筛选参数输入

修复代码 #

完整可运行代码如下：

library(shiny)
library(DT)
library(dplyr)

ui <- fluidPage(
  mainPanel(
    fluidRow(
      column(4, textInput('textInput1', label="输入鸢尾花类别，如setosa")),
      column(1, actionButton('button1', label="确认"))
    ),
    fluidRow(
      column(8, DT::dataTableOutput("table1")),
      column(4, DT::dataTableOutput("table2"))
    )
  )
)

server <- function(input, output, session){
  data(iris)
  function1 <- function(id){
    return(filter(iris, Species==id))
  }
  function2 <- function(df, var){
    return(filter(df, Sepal.Length==var))  
  }
  data <- reactiveValues()
  observeEvent(input$button1, { data$ID <- input$textInput1 })
  table1_rec <- reactive({ function1(data$ID) })
  
  output$table1 <- DT::renderDataTable({
    req(data$ID)
    DT::datatable(table1_rec(), selection = list(target = 'cell'))
  })
  
  table2_rec <- reactive({ 
    # 要求必须有选中的单元格才执行后续逻辑
    req(input$table1_cells_selected)
    # 提取选中单元格的行、列索引
    sel_row <- input$table1_cells_selected[,1]
    sel_col <- input$table1_cells_selected[,2]
    # 可选校验：仅选中Sepal.Length列的单元格才生效
    req(colnames(table1_rec())[sel_col] == "Sepal.Length")
    # 提取选中单元格的值
    selected_val <- table1_rec()[sel_row, sel_col]
    function2(table1_rec(), selected_val) 
  })
  
  output$table2 <- DT::renderDataTable({
    req(table2_rec())
    DT::datatable(table2_rec())
  })
}
shinyApp(ui, server)

补充说明 #

如果需要支持选中任意列的单元格值进行筛选，删除上述代码中Sepal.Length列的校验逻辑即可。

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