R/Shiny中DT DataTables单选反馈提交崩溃与取值失效问题

问题根因 #

• 动态输入ID冲突：生成的单选按钮ID固定为rec{行号}，切换不同缸数的数据集时，Shiny不会自动清除旧的输入值。当从低行数数据集切换到高行数数据集时，新增行对应的输入ID不存在，取值返回NULL，sapply遇到NULL会返回列表而非向量，写入CSV时触发unimplemented type 'list'类型错误。
• 响应式依赖缺失：feedbackInputData通过字符串拼接方式取input值，Shiny无法自动追踪动态生成的输入项的变化，导致该响应式表达式仅在切换缸数时计算一次，后续用户修改反馈选项不会触发更新，永远返回首次计算的默认值。

修复方案 #

1. 给动态输入ID增加缸数前缀，避免ID冲突：将单选按钮ID改为paste0("rec_", input$cyl, "_", 行号)，不同缸数的输入项ID完全独立，不会被旧值污染。
2. 改造feedbackInputData实现：通过reactiveValuesToList(input)触发全输入依赖，确保用户修改反馈选项时能更新取值。
3. 替换sapply为vapply，明确返回字符类型，避免生成列表，同时对未选中的反馈项填充默认值Neutral，规避NULL问题。

修复后完整代码 #

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

ui <- dashboardPage(
  header = dashboardHeader(title='Car Recommendations'),
  sidebar = dashboardSidebar(
    width = 450,
    fluidRow(
      column(
        width = 9,
        selectInput(
          "cyl", 'Select Cylinder Count:',
          choices = c('', sort(unique(mtcars$cyl)))
        )
      )
    )
  ),
  body = dashboardBody(
    fluidPage(
      fluidRow(
        uiOutput('rec_ui')
      )
    )
  )
)

server <- function(input, output, session) {
  mtcarsData <- reactive({
    req(input$cyl)
    mtcars %>%
      filter(cyl == input$cyl) %>%
      select(am, wt, hp, mpg)
  })
  
  output$rec_ui <- renderUI({
    req(mtcarsData())
    mainPanel(
      actionButton(
        'feedbackButton', 'Submit Feedback', class = 'btn-primary'
      ),
      dataTableOutput('rec'),
      width = 12
    )
  })
  
  feedbackInputData <- reactive({
    # 触发全输入依赖，确保动态输入变化时更新
    all_inputs <- reactiveValuesToList(input)
    mtcars <- mtcarsData()
    current_cyl <- input$cyl
    # 明确返回字符向量，处理NULL场景
    recsInput <- vapply(1:nrow(mtcars), function(row_id) {
      input_val <- input[[paste0('rec_', current_cyl, '_', row_id)]]
      ifelse(is.null(input_val), "Neutral", input_val)
    }, FUN.VALUE = character(1))
    recsInput
  })
  
  observeEvent(input$feedbackButton, {
    req(mtcarsData(), feedbackInputData())
    mtcars <- mtcarsData()
    feedbackInput <- feedbackInputData()
    
    recFeedbackDf <- bind_rows(
      lapply(1:nrow(mtcars), function(row_id)
        list(
          shiny_session_token = session$token,
          recommendation_type = 'CAR',
          input_cyl = input$cyl,
          recommended_mpg = mtcars$mpg[row_id],
          recommendation_feedback = feedbackInput[row_id],
          feedback_timestamp = as.character(Sys.time())
        )
      )
    )
    
    write.table(
      recFeedbackDf, 'feedback.csv', row.names = FALSE,
      quote = FALSE, col.names = !file.exists('feedback.csv'), sep = '|',
      append = TRUE
    )
    showModal(
      modalDialog(
        'Successfully submitted', easyClose = TRUE,
        footer = NULL, class = 'success'
      )
    )
  })
  
  output$rec <- DT::renderDataTable({
    df <- mtcarsData()
    current_cyl <- input$cyl
    
    feedbackCol <- lapply(1:nrow(df), function(recnum)
      as.character(
        radioButtons(
          # 增加缸数前缀避免ID冲突
          paste0('rec_', current_cyl, '_', recnum), '',
          choices = c('neutral' = 'Neutral', 'good' = 'Good', 'bad' = 'Bad'),
          inline = TRUE
        )
      )
    )
    feedbackCol <- tibble(Feedback = feedbackCol)
    
    df <- bind_cols(df, feedbackCol)
    
    df %>%
      DT::datatable(
        extensions = 'FixedColumns',
        rownames = FALSE,
        escape = FALSE,
        class="compact cell-border",
        options = list(
          pageLength = 10,
          lengthChange = FALSE,
          scrollX = TRUE,
          searching = FALSE,
          dom = 't',
          ordering = TRUE,
          fixedColumns = list(leftColumns = 2),
          preDrawCallback = JS(
            'function() { Shiny.unbindAll(this.api().table().node()); }'
          ),
          drawCallback = JS(
            'function() { Shiny.bindAll(this.api().table().node()); } '
          ),
          autoWidth = TRUE,
          columnDefs = list(
            list(width = '250px', targets = -1)
          )
        )
      )
  })
  
}

shinyApp(ui = ui, server = server)

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