在閃亮的DT中添加單選按鈕

Question

我有一個DT，其中使用以下代碼添加了另一列，其中包含單選按鈕。

library(shiny)
library(DT)
library(data.table)


ui <- fluidPage(
   sidebarLayout(
      sidebarPanel(
        tags$span("Dummy")
      ),
      mainPanel(
        DT::dataTableOutput("TableWithRadio"))
   )
)

server <- function(input, output) {
   output$TableWithRadio <- DT::renderDataTable({
      dt <- data.table(A = rnorm(1:10), B = rnorm(1:10))
      data.table(dt, Select = shinyInputModelingDB(radioButtons, nrow(dt), "radio_"))
   }, server = FALSE, escape = FALSE, rownames = F,
     options = list(paging = FALSE, searching = F, ordering = F,
     preDrawCallback = JS('function() { 
                          Shiny.unbindAll(this.api().table().node()); }'), 
     drawCallback    = JS('function() { 
                          Shiny.bindAll(this.api().table().node()); } ')

     ))

   shinyInputModelingDB = function(FUN, len, id, ...) { 
     inputs = character(len) 
     for (i in seq_len(len)) { 
       inputs[i] = as.character(FUN(paste0(id, i), choices = "", label = "",
                                 selected = F,  ...)) 
     } 
     return(inputs) 
   }
}

# Run the application 
shinyApp(ui = ui, server = server)

問題是我添加的單選按鈕不在同一組中，因為用戶可以選擇多個單選按鈕（在不同行中顯示）

我想要一種DT，其中用戶只能從整個表的行中選擇一個單選按鈕。

有什么想法可以解決嗎？

Answer 1

也許這會有所幫助。 原始Q / A來自此處 。 我剛剛刪除了這一行m=t(m) 。

現在單選按鈕是排他的，但回調函數不適用於列，而適用於行，因此單選按鈕目前不返回任何內容。

library(shiny)
library(DT)
shinyApp(
  ui = fluidPage(
    title = 'Radio buttons in a table',
    DT::dataTableOutput('foo'),
    verbatimTextOutput("test")
  ),
  server = function(input, output, session) {
    m = matrix(
      c(round(rnorm(24),1), rep(3,12)), nrow = 12, ncol = 3, byrow = F,
      dimnames = list(month.abb, LETTERS[1:3])
    )
    for (i in seq_len(nrow(m))) {
      m[i, 3] = sprintf(
        if_else(i == 1,
                '<input type="radio" name="%s" value="%s" checked="checked"/>',
                '<input type="radio" name="%s" value="%s"/>'),
        "C", month.abb[i]
      )
    }

    output$foo = DT::renderDataTable(
      m, escape = FALSE, selection = 'none', server = FALSE,
      options = list(dom = 't', paging = FALSE, ordering = FALSE),
      callback = JS("table.rows().every(function() {
                    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$test <- renderPrint(str(input$C))
    }
)