在Shiny中从DT数据表获取唯一ID与用户输入值的问题

尝试使用R中的DT包创建供用户审核的数据表，为表格添加包含selectInput下拉框的new_column列，让用户选择保留（keep）或删除（delete）事件。目前卡在如何从数据表中同时获取unique_id和用户输入值，以将更改应用到Shiny中的另一个数据框。希望用户点击submit按钮时触发值的捕获，想知道是否可以避免重渲染表格，还是捕获值必须重渲染表格。附上简化版代码：

library(DT)
library(tidyverse)
library(shiny)

ui <- fluidPage(
  DTOutput('myTableOutput'),
  br(),
  actionButton("submit", "Apply Changes")
)

server <- function(input, output, session) {
  # 假设df是包含unique_id列的数据框，这里先模拟示例数据
  df <- tibble(
    unique_id = paste0("id_", 1:5),
    event_details = paste("事件", 1:5),
    new_column = character(5)
  )
  
  for (i in 1:nrow(df)) {
    df$new_column[i] <- as.character(selectInput(
      inputId = df$unique_id[i], 
      label = NULL, 
      choices = c('keep'=TRUE, 'delete'=FALSE)
    ))
  }

  output$myTableOutput <- DT::renderDataTable({
    datatable(
      df, 
      escape = FALSE,
      filter = "none", 
      editable = 'new_column',
      selection = "none",
      options = list(
        dom = "t",
        initComplete = JS(
          "function(settings, json) {",
          "$(this.api().table().header()).css({'background-color': 'DimGray', 'color': 'white'});",
          "}"),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = FALSE)

  observeEvent(input$submit,{
    # 需要获取更改（最好是数据框格式），以便应用到另一个数据框
    reviewed_table <- as.data.frame(input$mytable_cell_edit)
  })
}

# 运行Shiny应用
shinyApp(ui, server)

解决方案 #

关键调整点 #

• 移除DT的editable参数：表格中是内嵌的selectInput控件，而非DT原生单元格编辑，该参数无实际作用
• 直接通过Shiny的input对象取值：每个selectInput的inputId绑定了unique_id，可直接遍历读取对应选择值
• 完全避免重渲染：捕获值仅读取Shiny输入状态，与表格渲染逻辑分离

修正后的完整代码 #

library(DT)
library(tidyverse)
library(shiny)

ui <- fluidPage(
  DTOutput('myTableOutput'),
  br(),
  actionButton("submit", "Apply Changes"),
  # 可选：展示收集到的结果用于验证
  verbatimTextOutput("reviewResult")
)

server <- function(input, output, session) {
  # 模拟包含unique_id的示例数据
  df <- tibble(
    unique_id = paste0("id_", 1:5),
    event_details = paste("事件", 1:5),
    new_column = character(5)
  )
  
  # 为每行生成selectInput，设置默认选择为keep
  for (i in 1:nrow(df)) {
    df$new_column[i] <- as.character(selectInput(
      inputId = df$unique_id[i], 
      label = NULL, 
      choices = c('keep'=TRUE, 'delete'=FALSE),
      selected = TRUE
    ))
  }

  output$myTableOutput <- DT::renderDataTable({
    datatable(
      df, 
      escape = FALSE,
      filter = "none", 
      selection = "none",
      options = list(
        dom = "t",
        initComplete = JS(
          "function(settings, json) {",
          "$(this.api().table().header()).css({'background-color': 'DimGray', 'color': 'white'});",
          "}"),
        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
      )
    )
  }, server = FALSE)

  observeEvent(input$submit,{
    # 收集每个unique_id对应的用户选择值
    reviewed_table <- df %>%
      mutate(
        user_choice = map_lgl(unique_id, ~ input[[.x]])
      ) %>%
      select(unique_id, user_choice)
    
    # 此处可将reviewed_table应用到目标数据框
    # 示例：target_df <- target_df %>% left_join(reviewed_table, by = "unique_id")
    
    # 可选：输出结果用于验证
    output$reviewResult <- renderPrint({
      reviewed_table
    })
  })
}

shinyApp(ui, server)

核心逻辑说明 #

1. 控件绑定：drawCallback中的Shiny.bindAll确保DT表格内的selectInput被Shiny正确识别，输入值能被捕获到input对象中
2. 值的收集：点击submit按钮时，通过map_lgl遍历所有unique_id，用input[[id]]获取对应selectInput的选择值，最终生成包含unique_id和选择结果的数据框
3. 无重渲染：整个过程不需要重新渲染DT表格，因为我们直接读取Shiny的输入状态，和表格的渲染逻辑完全分离

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