R-Shiny开发：表格内实现列维度可选单选按钮无法获取选中值

问题根因 #

• 原有JS回调逻辑错误：shiny-input-radiogroup类需要绑定在单选组对应的父容器上，且容器id需要和单选按钮的name属性完全一致，原有逻辑直接给列节点加类不符合Shiny的绑定规则
• 取值逻辑错误：同name属性的单选组选中值会统一绑定到input[[name]]，原有代码设置单选按钮的name为AValue，应该从input$AValue读取结果，而非从行名对应的变量读取

修改后可运行代码 #

library(shiny)
library(DT)

c1 = "This is comment 1"
c2 = "This is comment 2"
c3 = "This is comment 3"
c4 = "This is comment 4"
c5 = "This is comment 5"
comments = list(c1,c2,c3,c4,c5)

ui <- fluidPage(
  tags$head(tags$style(HTML("#foo tr.selected {background-color:red}"))),
  title = 'Radio buttons in a table',
  DT::dataTableOutput('foo'),
  verbatimTextOutput('sel')
)

server <- function(input, output) {
  m = matrix(
    as.character(1:5), nrow = 5, ncol = 1, byrow = FALSE,
    dimnames = list(comments, LETTERS[1])
  )
  for (i in seq_len(nrow(m))) {
    m[i, ] = sprintf(
      '<input type="radio" name="%s" value="%s"/>',
      "AValue", m[i, ]
    )
  }
  output$foo = DT::renderDataTable(
    m, escape = FALSE, selection = 'none', server = FALSE,
    options = list(dom = 't', paging = FALSE, ordering = FALSE),
    callback = JS("
      // 绑定单选组对应容器的id和类，匹配单选按钮的name属性
      var $radioContainer = $(table.table().node()).find('tbody');
      $radioContainer.attr('id', 'AValue');
      $radioContainer.addClass('shiny-input-radiogroup');
      Shiny.unbindAll(table.table().node());
      Shiny.bindAll(table.table().node());
    ")
  )
  output$sel = renderPrint({
    input$AValue
  })
}

shinyApp(ui = ui, server = server)

多列扩展说明 #

如果需要实现多列独立按列单选，按如下规则调整即可：

• 每一列的单选按钮设置独立的name属性，比如第一列用AValue、第二列用BValue
• 回调中分别为每一列的父容器设置与name一致的id，添加shiny-input-radiogroup类
• 服务端分别读取input$AValue、input$BValue即可获取各列的选中值

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