在R Shiny中将单选按钮添加到DT数据表

Question

我需要在DT Data Table的一列中添加单选按钮，并且选择单选按钮需要弹出一个按钮。我可以使用单选按钮完成相同的使用操作按钮，寻找实现相同的方法。使用操作按钮的代码：

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)
  )
})

}
)

Answer 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")
    )

  ))

})

})