如何点击DT::datatable的owner列单元格实现第二个数据框子集化

点击第一个DT::datatable的owner列中任意单元格，以此对第二个datatable进行子集化操作（即筛选出所有该owner对应的行）。

原app.R代码 #

library(shiny)
library(shinydashboard)
library(DT)

ckall<-structure(list(rowid = c(5704, 10243, 10116), PID = c("170040240", "170039927", "170184811"), county = c("Cheyenne", "Cheyenne", "Cheyenne"), ownerID = c(526, 526, NA), owner = c("JAMES A (TRUSTEE RUNDSTROM", "JAMES A (TRUSTEE RUNDSTROM", "UNITED METHODIST CHURCH")), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))
 
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    dataTableOutput("TABLE"),
    dataTableOutput("TABLE2")
  )
)

server<-(function(input, output, session) {
  output$TABLE<-renderDataTable({
    server = TRUE
    selection=list(target='cell')
    datatable(ckall, filter = 'top', editable = 'cell', class='hover cell-border stripe',
              caption = 'Kimball & Cheyenne Counties AOI',
              extensions = 'Buttons',
              options = list(dom = 'Bfrtip',scrollX=T,
                             buttons = c('copy', 'csv', 'excel')))
  })
  output$TABLE2 = DT::renderDataTable({
    req(input$TABLE_cells_selected)
    ckall[input$TABLE_cells_selected[,1], input$TABLE_cells_selected[,2], drop = F]
  })
})

shinyApp(ui, server)

修正后的app.R代码 #

library(shiny)
library(shinydashboard)
library(DT)

ckall<-structure(list(rowid = c(5704, 10243, 10116), PID = c("170040240", "170039927", "170184811"), county = c("Cheyenne", "Cheyenne", "Cheyenne"), ownerID = c(526, 526, NA), owner = c("JAMES A (TRUSTEE RUNDSTROM", "JAMES A (TRUSTEE RUNDSTROM", "UNITED METHODIST CHURCH")), row.names = c(NA, -3L), class = c("tbl_df", "tbl", "data.frame"))
 
ui <- dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    dataTableOutput("TABLE"),
    dataTableOutput("TABLE2")
  )
)

server <- function(input, output, session) {
  output$TABLE <- renderDataTable({
    datatable(ckall, 
              filter = 'top', 
              editable = 'cell', 
              class='hover cell-border stripe',
              caption = 'Kimball & Cheyenne Counties AOI',
              extensions = 'Buttons',
              selection = list(target='cell'),
              options = list(dom = 'Bfrtip',scrollX=T,
                             buttons = c('copy', 'csv', 'excel')))
  }, server = TRUE)

  output$TABLE2 = DT::renderDataTable({
    req(input$TABLE_cells_selected)
    
    # 获取选中单元格的列索引
    selected_col <- input$TABLE_cells_selected[,2]
    # 获取owner列的索引
    owner_col_idx <- which(colnames(ckall) == "owner")
    
    # 判断是否选中了owner列
    if(selected_col == owner_col_idx){
      # 获取选中单元格的owner值
      selected_owner <- ckall[input$TABLE_cells_selected[,1], selected_col, drop = TRUE]
      # 筛选所有该owner的行
      subset_data <- ckall[ckall$owner == selected_owner, , drop = FALSE]
    } else {
      # 非owner列点击时返回提示
      subset_data <- data.frame(提示信息 = "请点击owner列的单元格进行筛选")
    }
    
    datatable(subset_data, class='hover cell-border stripe')
  })
}

shinyApp(ui, server)

关键修改说明 #

• 调整参数位置：将server = TRUE和selection参数移至renderDataTable函数中，修正原代码参数位置错误的问题；
• 增加列判断逻辑：通过列名定位owner列，确保只有点击该列时才触发子集化操作；
• 修改子集化规则：提取选中单元格的owner值，筛选出数据中所有匹配该值的行；
• 补充异常处理：点击非owner列时返回提示信息，避免无意义输出。

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