响应式DT数据表中Radio Button问题：刷新后无法获取输入值

我需要实现一个带单选按钮的响应式DT数据表，逻辑参考Radio按钮在DT中的实现，但表格为reactive类型。每当表格重新计算（点击Refresh按钮刷新）后，点击单选按钮时输入值不再更新。复现代码如下：

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

shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    actionButton('refresca', 'Refresh'),
    withSpinner(DT::dataTableOutput('foo')),
    verbatimTextOutput('sel')
  ),
  server = function(input, output, session) {

    m <- 
      reactive({

        m <- 
          data.table(
            month1 = month.abb,
            A = '1',
            B = '2',
            C = '3',
            QWE = runif(12)
          )

        m %>% 
          mutate(across(c('A', 'B', 'C'), \(x) glue('<input type="radio" name="{month1}" value="{x}"/>')))

      }) %>% bindEvent(input$refresca)

    output$foo = DT::renderDataTable(
      {
        m = m()
        print(m)

      }, escape = FALSE, selection = 'none', server = FALSE, rownames=FALSE,
      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-radiogroup');
  });
                    Shiny.unbindAll(table.table().node());
                    Shiny.bindAll(table.table().node());")
    )

    output$sel = renderPrint({
      str(sapply(month.abb, function(i) input[[i]]))
    })
  }
)

问题原因 #

表格刷新后，原有的Shiny输入绑定未被正确清理，新渲染的单选按钮无法与Shiny的input对象建立有效的绑定关系，导致点击操作无法触发输入值更新。

修复方案 #

方案1：调整DT回调函数的绑定顺序 #

修改DT的回调逻辑，确保每次表格渲染时先解绑旧的Shiny绑定，再处理行元素，最后重新绑定新元素，同时优化初始数据加载逻辑：

library(shiny)
library(DT)
library(dplyr)
library(data.table)
library(glue)
library(shinycssloaders)

shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    actionButton('refresca', 'Refresh'),
    withSpinner(DT::dataTableOutput('foo')),
    verbatimTextOutput('sel')
  ),
  server = function(input, output, session) {

    m <- reactive({
      data.table(
        month1 = month.abb,
        A = '1',
        B = '2',
        C = '3',
        QWE = runif(12)
      ) %>% 
        mutate(across(c('A', 'B', 'C'), \(x) glue('<input type="radio" name="{month1}" value="{x}"/>')))
    }) %>% bindEvent(input$refresca, ignoreNULL = FALSE) # 初始加载即生成数据

    output$foo = DT::renderDataTable({
      m()
    }, escape = FALSE, selection = 'none', server = FALSE, rownames=FALSE,
    options = list(dom = 't', paging = FALSE, ordering = FALSE),
    callback = JS("
      // 先解绑当前表格容器内的所有旧绑定
      Shiny.unbindAll(this.api().table().node());
      // 为表格行设置ID和样式类
      table.rows().every(function(i, tab, row) {
        var $this = $(this.node());
        $this.attr('id', this.data()[0]);
        $this.addClass('shiny-input-radiogroup');
      });
      // 重新绑定新渲染的单选按钮元素
      Shiny.bindAll(this.api().table().node());
    ")
    )

    output$sel = renderPrint({
      str(sapply(month.abb, function(i) input[[i]]))
    })
  }
)

修改说明：

• 添加ignoreNULL = FALSE到bindEvent，确保App启动时就生成初始表格数据
• 调整回调函数顺序：先执行Shiny.unbindAll清理旧绑定，再处理行元素，最后执行Shiny.bindAll绑定新元素
• 使用this.api().table().node()更精准地定位表格容器，避免绑定对象错误

方案2：通过renderUI重建表格输出（备选） #

如果方案1仍有问题，可以通过renderUI每次数据更新时重建整个表格输出组件，确保DOM完全刷新：

library(shiny)
library(DT)
library(dplyr)
library(data.table)
library(glue)
library(shinycssloaders)

shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    actionButton('refresca', 'Refresh'),
    withSpinner(uiOutput('foo_ui')), # 替换为uiOutput
    verbatimTextOutput('sel')
  ),
  server = function(input, output, session) {

    m <- reactive({
      data.table(
        month1 = month.abb,
        A = '1',
        B = '2',
        C = '3',
        QWE = runif(12)
      ) %>% 
        mutate(across(c('A', 'B', 'C'), \(x) glue('<input type="radio" name="{month1}" value="{x}"/>')))
    }) %>% bindEvent(input$refresca, ignoreNULL = FALSE)

    # 每次数据更新时重建dataTableOutput
    output$foo_ui <- renderUI({
      m() # 触发依赖，确保数据更新时重建输出
      DT::dataTableOutput('foo')
    })

    output$foo = DT::renderDataTable({
      m()
    }, escape = FALSE, selection = 'none', server = FALSE, rownames=FALSE,
    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-radiogroup');
      });
      Shiny.bindAll(table.table().node());
    ")
    )

    output$sel = renderPrint({
      str(sapply(month.abb, function(i) input[[i]]))
    })
  }
)

修改说明：

• UI层用uiOutput('foo_ui')替代直接的dataTableOutput('foo')
• 新增output$foo_ui <- renderUI(...)，每次m()更新时重建dataTableOutput组件，确保DOM完全刷新后再绑定Shiny输入

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