如何在R Shiny DT中实现含NumericInput与响应列的表格？

我来帮你搞定这个类似Excel公式单元格的需求——在Shiny DataTable里给每行添加一个NumericInput输入框，并且让计算列实时响应输入的变化。针对你用iris数据集计算花瓣面积的需求，我调整了代码，确保输入变化时计算列能实时更新，具体实现如下：

完整代码 #

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

ui <- basicPage(
  DT::dataTableOutput('x1')
)

server <- function(input, output, session) {
  # 生成每行的Shiny输入控件
  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), label = NULL, ...))
    }
    inputs
  }
  
  # 获取所有输入控件的当前值
  shinyValue <- function(id, len) {
    unlist(lapply(seq_len(len), function(i) {
      value <- input[[paste0(id, i)]]
      # 如果输入未初始化，默认返回1
      if (is.null(value)) 1 else value
    }))
  }
  
  # 构建带输入控件和计算列的响应式数据框
  DF <- reactive({
    iris %>%
      mutate(
        Adjust = shinyInput(numericInput, nrow(iris), 'adj', value = 1, min = 0.1, step = 0.1),
        Petal_Area = round(Petal.Length * Petal.Width / shinyValue('adj', nrow(iris)), 2)
      ) %>%
      select(Species, Petal.Length, Petal.Width, Adjust, Petal_Area) # 调整列顺序更清晰
  })
  
  # 渲染DataTable，确保Shiny输入控件正确绑定
  output$x1 <- DT::renderDataTable(
    DF(),
    server = FALSE,
    escape = FALSE, # 不要转义HTML输入控件
    options = list(
      preDrawCallback = JS('function() { Shiny.unbindAll(this.api().table().node()); }'),
      drawCallback = JS('function() { Shiny.bindAll(this.api().table().node()); }'),
      columnDefs = list(list(targets = 3, orderable = FALSE)) # 禁止对输入列排序，避免混乱
    )
  )
}

shinyApp(ui, server)

关键细节说明 #

• 输入控件生成：shinyInput函数为每行生成一个唯一ID的NumericInput（比如adj1、adj2），确保Shiny能正确识别每个输入的变化。
• 实时值获取：shinyValue函数遍历所有输入控件，获取当前值，当任何一个输入变化时，这个函数会触发响应式更新。
• 计算列更新：在DF这个响应式数据框中，Petal_Area列的计算依赖shinyValue的结果，所以只要输入变化，计算列就会自动重新计算并更新表格。
• Shiny输入绑定：通过preDrawCallback和drawCallback的JS代码，确保每次表格重绘时都重新绑定Shiny输入控件，避免分页或排序后输入控件失效。
• 体验优化：添加了min和step参数限制输入范围，同时设置输入列不可排序，避免操作混乱，计算结果保留两位小数更易读。

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