点击DT后弹出窗口

Question

我正在努力获得一个弹出窗口后，点击一个动作按钮是在数据表内。所有的按钮都有相同的id。有人能帮我看看下面的例子吗?

的例子:

rm(list = ls())
library("shiny")
library("shinydashboard")
library("shinyBS")
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
header <- dashboardHeader(title = "Example")
body <- dashboardBody(
    mainPanel(
        dataTableOutput("mytable"),
        bsModal("myModal", "Your plot", "button", size = "large",plotOutput("plot"))
    )               )
sidebar <- dashboardSidebar()
ui <- dashboardPage(header,sidebar,body,skin="red")
server = function(input, output, session) {
    randomVals <- eventReactive(input$button, {
        runif(50)       })
    output$plot <- renderPlot({
        hist(randomVals())
    })

    output$mytable = renderDataTable({
  #    addCheckboxButtons <- paste('<button id="button" type="button" data-toggle="modal" class="btn btn-default action-button">Show modal</button>')
      addCheckboxButtons <- paste('<button id="button" type="button" class="btn btn-default action-button" data-toggle="modal" data-target="myModal">Open Modal</button>')
        cbind(Pick=addCheckboxButtons, mymtcars)
    }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25),escape=F
    )
    observeEvent(input$button, {
        toggleModal(session, "myModal", "open")
    })
    }
runApp(list(ui = ui, server = server))

Answer 1

我让它工作，但它需要很多东西。首先，我让每个按钮都是独一无二的。你不能复制HTML id。接下来，要在DataTables中使用Shiny输入，你必须在回调事件中使用javascript解除绑定。由于前面提到的HTML复制问题，我为每个按钮创建了一个惟一的bsModal和plot。我用了很多lapply。您还需要DT包。下面是代码:

rm(list = ls())
library("shiny")
library("DT")
library("shinydashboard")
library("shinyBS")
mymtcars = mtcars
mymtcars$id = 1:nrow(mtcars)
shinyInput = function(FUN, len, id, ...)
{
  inputs = character(len)
  for (i in seq_len(len))
  {
    inputs[i] = as.character(FUN(paste0(id, i), ...))
  }
  inputs
}
header <- dashboardHeader(title = "Example")
body <- dashboardBody(mainPanel(DT::dataTableOutput("mytable"), 
                                lapply(seq_len(nrow(mtcars)), 
                                 function(i)
                                   {
                                     bsModal(paste0("myModal", i), "Your plot", paste0("btn", i), size = "large", 
                                      plotOutput(paste0("plot", i)))
                                     })))
sidebar <- dashboardSidebar()
ui <- dashboardPage(header, sidebar, body, skin = "red")
server = function(input, output, session)
{
  randomVals <- reactive({
    # call input from each button arbitrarily in code to force reactivity
    lapply(seq_len(nrow(mymtcars)), function(i)
    {
      input[[paste0("btn",i)]]
      })
    runif(50)
  })
  plot <- reactive({
    hist(randomVals())
  })
  lapply(seq_len(nrow(mymtcars)), function(i)
  {
    output[[paste0("plot", i)]] <- renderPlot(plot())

    observeEvent(input[[paste0("btn", i)]], {
      toggleModal(session, paste0("myModal", i), "open")
    })
  })
  output$mytable = DT::renderDataTable({
    btns <- shinyInput(actionButton, nrow(mymtcars), "btn", label = "Show modal")
    cbind(Pick = btns, mymtcars)
  }, options = list(orderClasses = TRUE, lengthMenu = c(5, 25, 50), pageLength = 25, 
                    preDrawCallback = JS("function() { 
                                         Shiny.unbindAll(this.api().table().node()); }"), 
                    drawCallback = JS("function() { 
                                      Shiny.bindAll(this.api().table().node()); } ")), 
  escape = F)
  }
runApp(list(ui = ui, server = server))