Shiny DT表格selectInput响应式数据更新后失效问题修复

之前遇到Shiny DT表格重载后输入控件响应性问题，当时采用JavaScript解绑的方案在静态数据场景下有效，但在响应式数据场景中失效。

具体问题表现：首次点击「Update data」加载数据时，selectInput可正常工作，input$id1能响应用户选择；但再次点击更新响应式数据后，input$id1不再响应。

已知两种解决思路：使用dataTableProxy()与replaceData()，或每次更新时重命名selectInput的ID，现寻求无需这两种方案的最小改动解决办法。

错误代码示例 #

require(shiny)
require(DT)

shinyApp(
  ui = fluidPage(
    tags$head(tags$script(
      HTML(
        "Shiny.addCustomMessageHandler('unbindDT', function(id) {
            var $table = $('#'+id).find('table');
            if($table.length > 0){
              Shiny.unbindAll($table.DataTable().table().node());
            }
          })")
    )),
    actionButton(inputId = "update", label = "Update data"),
    uiOutput("resettable_table")
  ),
  server = function(input, output, session) {
    rv <- reactiveValues(
      times = 1, 
      mydata = NULL
    )
    
    observeEvent(input$update, {
      session$sendCustomMessage("unbindDT", "mytable")
      rv$times <- rv$times + 1
      rv$mydata <- data.frame(
        Col1 = as.character(selectInput(
          inputId = "id1",
          label = NULL,
          choices = paste0(letters, input$update),
          selected = paste0(letters, input$update)[1],
        ))
      )
    })
    
    output$mytable <- DT::renderDataTable({
      req(rv$mydata)
      DT::datatable(
        data = rv$mydata,
        escape = F,
        selection = "none",
        options = list(
          preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
          drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
        )
      )
    }, server = F)
    
    output$resettable_table <- renderUI({
      req(rv$times)
      div(
        id = paste0("mydiv", rv$times),
        DT::dataTableOutput("mytable")
      )
    })
    
    observe({
      if(is.null(input$id1)) {
        print("input$id1 is NULL")
      } else {
        print(paste(c("input$id1:", input$id1)))
      }
    })
    
  })

修复说明及代码 #

感谢@StephaneLaurent指出问题根源：用于记录数据重载次数的响应式计数器，以及将DT表格置于ID动态更新的div中这一操作导致了失效。修复时只需移除动态div和计数器，直接渲染DT表格即可。

修复后的代码如下：

require(shiny)
require(DT)

shinyApp(
  ui = fluidPage(
    tags$head(tags$script(
      HTML(
        "Shiny.addCustomMessageHandler('unbindDT', function(id) {
            var $table = $('#'+id).find('table');
            if($table.length > 0){
              Shiny.unbindAll($table.DataTable().table().node());
            }
          })")
    )),
    actionButton(inputId = "update", label = "Update data"),
    DT::dataTableOutput("mytable")
  ),
  server = function(input, output, session) {
    rv <- reactiveValues(mydata = NULL)
    
    observeEvent(input$update, {
      session$sendCustomMessage("unbindDT", "mytable")
      rv$mydata <- data.frame(
        Col1 = as.character(selectInput(
          inputId = "id1",
          label = NULL,
          choices = paste0(letters, input$update),
          selected = paste0(letters, input$update)[1],
        ))
      )
    })
    
    output$mytable <- DT::renderDataTable({
      req(rv$mydata)
      DT::datatable(
        data = rv$mydata,
        escape = F,
        selection = "none",
        options = list(
          preDrawCallback = JS('function(){Shiny.unbindAll(this.api().table().node());}'),
          drawCallback = JS('function(){Shiny.bindAll(this.api().table().node());}')
        )
      )
    }, server = F)
    
    observe({
      if(is.null(input$id1)) {
        print("input$id1 is NULL")
      } else {
        print(paste(c("input$id1:", input$id1)))
      }
    })
    
  })

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