javascript - shiny点击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 解除绑定(bind)。由于我之前提到的 HTML 重复内容，我创建了一个独特的 bsModal 并为每个按钮绘制。我用了很多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))