如何在Shiny的DT表格添加新行时保留原有小部件的值？

问题根源 #

当前代码中，rv$data存储的是小部件的HTML字符串，而非用户实际选择/勾选的值。当添加新行触发表格重新渲染时，所有旧行的小部件都会被重新生成，导致之前的设置丢失，回到默认状态。

解决方案 #

核心思路是在添加新行前，将现有行的小部件当前值同步回rv$data，重新生成带有用户设置状态的小部件HTML，再添加新行。修改后的完整代码如下：

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

# 创建初始数据集
data_survey <- data.frame(
  Question = c("Quel est votre âge?"),
  Option = c(NA),
  Type = as.character(selectInput(paste0("type_", 1), "",
                                  choices = c("numérique","texte","choix multiple","selection","oui/non","matrice"),
                                  width = "100px")),
  Id = c("age"),
  Dépendence = as.character(checkboxInput(paste0("dependency_", 1),"",FALSE)),
  `Valeur de la dépendence` = c(NA),
  `Réponse obligatoire` = as.character(checkboxInput(paste0("obligatory_", 1),"",FALSE))
)

# UI定义
ui <- fluidPage(
  titlePanel("Créer son questionnaire"),
  tags$head(tags$link(rel = "stylesheet", type = "text/css", href = "www/style.css")),
  DT::dataTableOutput("table"),
  br(),
  actionButton("add_row", "Ajouter une ligne"),
  actionButton("delete_row", "Supprimer la ligne sélectionnée"),
  actionButton("create_survey", "Prévisualiser"),
  br(), br(), br(), br(), br(),
  verbatimTextOutput('type')
)

server <- function(input, output, session) {
  
  rv <- reactiveValues(data = data_survey)
  
  # 同步现有行的小部件值到rv$data
  sync_widget_values <- function() {
    n <- nrow(rv$data)
    if(n == 0) return()
    
    # 更新Type列的下拉框，保留当前选中值
    rv$data$Type <- sapply(1:n, function(i) {
      selected_val <- input[[paste0("type_", i)]]
      as.character(selectInput(paste0("type_", i), "",
                               choices = c("numérique","texte","choix multiple","selection","oui/non","matrice"),
                               selected = selected_val,
                               width = "100px"))
    })
    
    # 更新Dépendence列的复选框，保留当前勾选状态
    rv$data$Dépendence <- sapply(1:n, function(i) {
      checked_val <- input[[paste0("dependency_", i)]]
      as.character(checkboxInput(paste0("dependency_", i), "", value = checked_val))
    })
    
    # 更新Réponse obligatoire列的复选框，保留当前勾选状态
    rv$data$`Réponse obligatoire` <- sapply(1:n, function(i) {
      checked_val <- input[[paste0("obligatory_", i)]]
      as.character(checkboxInput(paste0("obligatory_", i), "", value = checked_val))
    })
  }
  
  output$table = DT::renderDataTable(
    rv$data, 
    escape = FALSE, 
    editable = TRUE, 
    selection = 'single', 
    server = FALSE,
    options = list(dom = 't', paging = FALSE, ordering = FALSE),
    callback = JS("table.rows().every(function(i, tab, row) {
        var $this = $(this.node());
        $this.attr('id', this.data()[0]);
        $this.addClass('shiny-input-container');
      });
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());")
  )
  
  observeEvent(input$add_row, {
    # 先同步现有行的小部件值，避免重置
    sync_widget_values()
    
    new_row_num <- nrow(rv$data) + 1
    new_data <-  data.frame(
      Question = NA,
      Option = NA,
      Type = as.character(selectInput(paste0("type_", new_row_num), "",
                                      choices = c("numérique","texte","choix multiple","selection","oui/non","matrice"),
                                      width = "100px")),
      Id = NA,
      Dépendence = as.character(checkboxInput(paste0("dependency_", new_row_num), "", FALSE)),
      `Valeur de la dépendence` = NA,
      `Réponse obligatoire` = as.character(checkboxInput(paste0("obligatory_", new_row_num), "", FALSE))
    )
    
    rv$data <- rbind(rv$data, new_data)
  })
  
  output$type = renderPrint({
    str(sapply(1:nrow(rv$data), function(i) input[[paste0("type_", i)]]))
    str(sapply(1:nrow(rv$data), function(i) input[[paste0("obligatory_", i)]]))
  })
}

shinyApp(ui, server)

关键修改说明 #

1. 新增同步函数：sync_widget_values函数会遍历所有现有行，从input对象中获取每个小部件的当前值，重新生成带有用户设置状态的小部件HTML，替换rv$data中对应的列内容。
2. 调整添加新行逻辑：在添加新行前先调用同步函数，确保旧行的小部件状态被保存，再生成并添加新行的默认小部件。

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