【问题标题】：Adding radio button to the DT Data Table in R Shiny将单选按钮添加到 R Shiny 中的 DT 数据表
【发布时间】：2017-09-05 10:12:58
【问题描述】：

我需要在 DT 数据表的一列中添加单选按钮，并且在选择单选按钮时需要弹出带有按钮的弹出窗口。我可以使用操作按钮完成相同的操作，寻找使用单选按钮实现相同功能的方法。带有操作按钮的代码：

library(shiny)
library(DT)
library(shinyBS)

shinyApp(
ui <- fluidPage(
actionButton("Refresh","Refresh"),
br(),
br(),
DT::dataTableOutput("table"),uiOutput("popup")
),

server <- function(input, output,session) {

shinyInput <- function(FUN, len, id, ...) {
  inputs <- character(len)
  for (i in seq_len(len)) {
    inputs[i] <- as.character(FUN(paste0(id, i), ...))
  }
  inputs
}

df <- reactiveValues(data = data.frame(
  cbind(Delete = shinyInput(actionButton,nrow(mtcars),'button_', label = " ",onclick = 'Shiny.onInputChange(\"select_button\",  this.id)'),
        mtcars)
))

output$table <- DT::renderDataTable(
  df$data, server = FALSE, escape = FALSE, selection = 'none'
)

observeEvent(input$select_button, {
  toggleModal(session, "modalExample", "open")
})

SelectedRow <- eventReactive(input$select_button,{
  as.numeric(strsplit(input$select_button, "_")[[1]][2])
})

output$popup <- renderUI({
  bsModal("modalExample", "Do you want to delete the row?", "", size = "large",
          actionButton("Delete","Delete")
  )
})

observeEvent(input$Refresh,{
  mtcars <<- retrieveValues()
  df$data <-  data.frame(
    cbind(Delete = shinyInput(actionButton,nrow(mtcars),'button_', label = HTML('<input type="radio" name="radio" value="1"/>'),onclick = 'Shiny.onInputChange(\"select_button\",  this.id)'),
          mtcars)
  )
})

}
)

【问题讨论】：

标签： javascript r shiny dt

【解决方案1】：

代码

shinyApp(
ui = fluidPage(
title = 'Radio buttons in a table',
tags$div(id="C",class='shiny-input-radiogroup',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(
    
    '<input type="radio" name="%s" value="%s"/>',
    
    "C", month.abb[i]
  )
}
m
output$foo = DT::renderDataTable(
  m, escape = FALSE, selection = 'single', server = FALSE,
  options = list(dom = 't', paging = FALSE, ordering = FALSE)
)
output$test <- renderPrint(str(input$C))

output$popup <- renderUI({
  bsModal("modalExample", "Do you want to delete the row?", "", size = "large",
          actionButton("Delete","Delete")
  )
})

observeEvent(input$C, {
  
  #print("TESTING")
  
  showModal(modalDialog(
    title = "Do you want to delete the row?",
    actionButton("delete","Delete"),
    size = "l",
    easyClose = TRUE,
    fade = TRUE,
    footer = tagList(
      modalButton("Close")
    )
    
  ))
  
})

})

【讨论】：