如何在Shiny单元格SelectInput更新时保存DataTable内容？

你的代码无法保存下拉框选择值的核心原因：

• 直接将selectInput的HTML字符串插入表格单元格，DT的cell_edit事件无法识别这类外部Shiny组件的变化。
• 所有下拉框共用同一个inputId，无法区分不同行的选择操作。

修改后的完整代码如下：

library(DT)
library(htmltools)
library(shiny)
library(readr)

save_ref_values <- function(df, name) {
  write.csv(df, name, row.names = FALSE)  
}

# 初始化数据（如果没有missing_values.csv则用这个）
missing_values <- structure(list(field_label = c("Date0:", "SR"),
                                 id = c("link","n"),
                                 field = c("date1", "a"), 
                                 value = c(NA, NA),
                                 form = c("eval 3", "eval 4"),
                                 event = c("5", "5"), 
                                 label = c("1", "1"),
                                 field_type = c("text", "radio"), 
                                 required = c("y", "y"),
                                 logic = c(NA_character_, NA_character_),
                                 Commentaires = c(NA, NA), 
                                 Statut = c(NA, NA)), 
                            row.names = 1:2, class = "data.frame")

# 确保初始CSV存在
if(!file.exists("missing_values.csv")){
  save_ref_values(missing_values, "missing_values.csv")
}

datatableFactory <- function(df) {
  # 定义下拉框渲染函数
  render_select <- function(col, choices) {
    JS(paste0("function(data, type, row, meta) {
      if(type === 'display') {
        var id = '", col, "_row_' + meta.row;
        return '<select id=\"' + id + '\" class=\"form-control\">' + 
          ", paste0(sapply(choices, function(choice) {
            paste0("'<option value=\"", choice, "\"' + (data === '", choice, "' ? ' selected' : '') + '>", choice, "</option>")
          }), collapse = " + "), " + 
          '</select>';
      }
      return data;
    }"))
  }
  
  DT::datatable(df,
                options = list(pageLength = 5, autoWidth = TRUE,
                               columnDefs = list(
                                 list(targets = which(names(df) == "Statut"), 
                                      render = render_select("statut", c('','yes','no', 'refused'))),
                                 list(targets = which(names(df) == "Commentaires"), 
                                      render = render_select("commentaires", c('','b','c','d')))
                               )),
                filter = list(position = 'top', clear = FALSE),
                escape = F,
                selection = "none" # 不需要选中行
  )
}

ui <- fluidPage(
  titlePanel("Génération du Rapport"),
  mainPanel(
    h2("Rapport Preview"),
    DTOutput("missing_values_dt_table"),
  )
)

server <- function(input, output, session) {
  missing_values_data <- reactiveVal(read.csv("missing_values.csv", stringsAsFactors = FALSE))
  
  output$missing_values_dt_table <- renderDT({
    datatableFactory(missing_values_data())
  })
  
  # 监听所有Statut下拉框的变化
  observe({
    lapply(1:nrow(missing_values_data()), function(row) {
      inputId <- paste0("statut_row_", row-1) # DT的行号从0开始
      observeEvent(input[[inputId]], {
        new_data <- missing_values_data()
        new_data[row, "Statut"] <- input[[inputId]]
        missing_values_data(new_data)
        save_ref_values(new_data, "missing_values.csv")
      }, ignoreInit = TRUE)
    })
  })
  
  # 监听所有Commentaires下拉框的变化
  observe({
    lapply(1:nrow(missing_values_data()), function(row) {
      inputId <- paste0("commentaires_row_", row-1) # DT的行号从0开始
      observeEvent(input[[inputId]], {
        new_data <- missing_values_data()
        new_data[row, "Commentaires"] <- input[[inputId]]
        missing_values_data(new_data)
        save_ref_values(new_data, "missing_values.csv")
      }, ignoreInit = TRUE)
    })
  })
}

shinyApp(ui, server)  

关键修改说明 #

1. 唯一InputID：给每个行的下拉框生成唯一ID（如statut_row_0、commentaires_row_1），确保能区分不同行的操作。
2. DT原生渲染：用DT的columnDefs和render选项生成下拉框，既保留表格样式一致性，又能通过Shiny监听输入变化。
3. 独立监听事件：分别监听Statut和Commentaires列所有下拉框的变化，更新响应式数据并立即保存到CSV。
4. 初始文件检查：添加了CSV文件存在性检查，避免首次运行报错。

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