将单选按钮添加到R数据表中的闪亮

Question

我需要将单选按钮添加到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) 
) 
}) 

} 
) 

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

)) 

}) 

})