Shiny中带下拉控件的可编辑DT表格weight列计算返回NA如何解决

问题核心原因 #

• 初始化表格时，你将NMonth列的所有值替换为了selectInput组件的HTML字符串，而非用户实际选择的数值，对HTML字符串执行as.numeric()转换自然生成NA，触发强制转换警告
• 原代码中监听input$foo_cell_edit的逻辑是为DT原生可编辑单元格设计的，不适用于嵌入的Shiny输入组件，无法拿到用户选择的下拉框值
• 原Date_point列所有行的dateInput使用了重复ID，会导致选择异常

修复步骤 #

1. 调整dateInput的ID生成逻辑，为每行的日期组件分配独立ID
2. 点击计算按钮时，直接遍历读取每行对应selectInput的真实输入值，而非读取表格中存储的HTML字符串
3. 移除无效的单元格编辑监听逻辑，替换为直接读取输入组件值的计算逻辑

修复后完整代码 #

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

ui <- fluidPage(
  DT::dataTableOutput('foo'),
  actionButton("do", "Calculate"),
  verbatimTextOutput('sel'),
  verbatimTextOutput('sel2'),
  verbatimTextOutput('date1')
)

server <- function(input, output, session) {
  df1 <- reactiveValues(data=NULL)
  data = data.frame(
    Observation = c('A', 'B', 'C', 'D', 'E', 'F', 'G'),
    Date_point=c(NA, NA, NA, NA, NA, NA, NA),
    Verification=c(NA, NA, NA, NA, NA, NA, NA),
    NMonth=c(12, 12, 12, 12, 12, 12, 12)
  )
  
  data <- data %>%
    mutate(weight = 12/ NMonth)
  
  # 为每行嵌入输入组件
  for (i in 1:nrow(data)) {
    data$Verification[i] <- as.character(selectInput(paste0("sel", i), "", choices = c('(Audited)', '(Unaudited)' ), width = "100px"))
  }
  
  for (i in 1:nrow(data)) {
    data$NMonth[i] <- as.character(selectInput(paste0("sel2", i), "", choices = 1:12, selected = 12, width = "100px"))
  }
  
  for (i in 1:nrow(data)) {
    # 修正日期组件ID重复问题
    data$Date_point[i] <- as.character(dateInput(paste0("date", i), "Date:", value = "2012-02-29", width = "100px"))
  }
  
  dat <- reactive({
    data
  })
  
  observe({
    df1$data <- dat()
  })
  
  ## 表格输出配置
  output$foo = DT::renderDataTable(
    df1$data,
    escape = F,
    editable = T,
    selection = 'none',
    server = F,
    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());"),
    rownames = F
  )
  
  observeEvent(input$do, {
    # 遍历读取每行NMonth下拉框的实际输入值
    nmonth_vals <- sapply(1:nrow(df1$data), function(row_idx) {
      as.numeric(input[[paste0("sel2", row_idx)]])
    })
    # 计算weight列
    df1$data$weight <- 12 / nmonth_vals
  })
}

shinyApp(ui, server)

验证方式 #

运行代码后选择任意行的NMonth下拉值，点击Calculate按钮即可得到1-12之间的正确weight值，不会再出现强制转换NA的警告。

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