DT: R Shiny应用中基于另一列selectInput动态修改列值

• 原代码把selectInput生成逻辑和Score列更新逻辑放在同一个响应式上下文里，每次Score更新都会重写整个rv$tbl，连带重新生成所有行的下拉菜单，既会重置用户选择，也会触发无限循环
• 初始数据框没有提前声明Feedback、Score两列，动态赋值容易出现类型错误

if(interactive()){
  library(DT)
  library(shiny)
  # 初始化时提前创建Feedback、Score列
  tbl1 <- data.frame(A = c(1:10), B = LETTERS[1:10], C = c(11:20), D = LETTERS[1:10],
                     Feedback = character(10), Score = numeric(10))
  ui <- fluidPage(
    DT::dataTableOutput(outputId = 'my_table')
  )
  server <- function(input, output, session) {
    rv <- reactiveValues(tbl = tbl1)
    
    # 仅初始生成一次所有行的selectInput，不要放在会重复触发的observe里
    for (i in 1:nrow(rv$tbl)) {
      rv$tbl$Feedback[i] <- as.character(selectInput(paste0("sel", i), "",
                                                     choices = c(1,2,3,4)
      ))
    }
    
    # 单独监听所有下拉框的输入变化，仅更新对应行的Score
    observe({
      for (i in 1:nrow(rv$tbl)) {
        sel_val <- input[[paste0("sel", i)]]
        if(!is.null(sel_val)) {
          rv$tbl$Score[i] <- switch(sel_val,
                                    "1" = 10,
                                    "2" = 20,
                                    "3" = 25,
                                    "4" = 30)
        }
      }
    })
    
    output$my_table = DT::renderDataTable({
      datatable(
        rv$tbl, escape = FALSE, selection = 'none', rownames = F,
        options = list( paging = FALSE, ordering = FALSE, scrollX = TRUE, dom = "t",
                        preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
                        drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); } ')
        )
      )
    }, server = FALSE)
  }
  shinyApp(ui = ui, server = server)
}

• 拆分了下拉框生成和Score更新的逻辑，下拉框仅初始化生成一次，不会因为Score更新被反复重写
• 用switch替代多层ifelse，逻辑更简洁易维护
• 提前初始化了需要用到的两列，避免动态赋值的潜在错误

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