如何在Shiny模块的DataTable中添加单选按钮并获取选中值？

修改后的JS回调函数 #

针对单选按钮场景，我们调整了事件监听逻辑、行索引提取方式和值获取方法，确保适配多页DataTable：

js <- function(dtid, ns) {
  c(
    "$('body').on('change', '[name^=radio_row]', function(){",
    "  // 从name属性提取原始数据行索引（单选按钮按行分组，name格式为radio_row_xxx）",
    "  var name = this.getAttribute('name');",
    "  var i = parseInt(/radio_row_(\\d+)/.exec(name)[1]);",
    "  // 获取当前选中的单选按钮值（'a'/'b'/'c'）",
    "  var value = $(this).val();",
    "  // 构造DT.cellInfo格式的对象，col值需根据单选按钮列的实际位置调整（从0开始计数）",
    "  var info = [{row: i, col: 2, value: value}];",
    sprintf(
      "Shiny.setInputValue('%s', info);",
      ns(sprintf("%s_cell_edit:DT.cellInfo", dtid))
    ),
    "})"
  )
}

关键改动说明 #

• 事件监听目标：从复选框的[id^=checkb]改为单选按钮的[name^=radio_row]，利用相同name属性实现同一行单选按钮的互斥选择。
• 行索引提取：通过单选按钮的name属性提取原始数据行索引，避免分页场景下因页面行号与数据源行号不一致导致的错误。
• 值获取逻辑：用$(this).val()直接获取选中单选按钮的value属性值，替代复选框的checked状态判断。

完整Shiny模块示例 #

以下是可直接运行的完整模块代码，包含单选按钮列渲染、选中值同步及结果展示：

模块UI部分

radioTableUI <- function(id) {
  ns <- NS(id)
  tagList(
    DT::dataTableOutput(ns("my_table")),
    verbatimTextOutput(ns("selected_results"))
  )
}

模块Server部分

radioTableServer <- function(id) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # 初始化测试数据
    df <- reactiveVal(
      data.frame(
        ID = 1:10,
        Item = paste0("Product ", 1:10),
        Selection = rep("", 10),
        stringsAsFactors = FALSE
      )
    )
    
    # 生成单一行的单选按钮HTML
    build_radio_group <- function(row_idx) {
      options <- c("a", "b", "c")
      radio_items <- lapply(options, function(opt) {
        tags$input(
          type = "radio",
          name = ns(paste0("radio_row_", row_idx)),
          id = ns(paste0("radio_", row_idx, "_", opt)),
          value = opt
        ) %>%
          tagAppendChild(tags$span(paste0(" ", opt))) %>%
          tagAppendChild(tags$br())
      })
      HTML(paste(radio_items, collapse = ""))
    }
    
    # 渲染带单选按钮的DataTable
    output$my_table <- DT::renderDataTable({
      dat <- df()
      # 为每一行生成单选按钮列
      dat$Selection <- lapply(0:(nrow(dat)-1), build_radio_group)
      
      DT::datatable(
        dat,
        escape = FALSE, # 允许渲染HTML内容
        callback = JS(js("my_table", ns)),
        options = list(
          pageLength = 5, # 开启分页测试多页兼容性
          columnDefs = list(list(targets = 2, orderable = FALSE)) # 单选按钮列禁用排序
        )
      )
    })
    
    # 同步选中值到数据源
    observeEvent(input$my_table_cell_edit, {
      info <- input$my_table_cell_edit[[1]]
      current_df <- df()
      # DT行/列索引从0开始，R数据框从1开始，需做偏移
      current_df[info$row + 1, info$col + 1] <- info$value
      df(current_df)
    })
    
    # 展示选中结果
    output$selected_results <- renderPrint({
      df() %>% dplyr::select(ID, Item, Selection)
    })
  })
}

主应用调用模块

ui <- fluidPage(
  radioTableUI("table_demo")
)

server <- function(input, output, session) {
  radioTableServer("table_demo")
}

shinyApp(ui, server)

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