闪亮点击DT后弹出window

Question

单击数据 Table 内的操作按钮后，我正在努力获取弹出窗口 window。所有按钮都具有相同的 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 和绘图。我用了很多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))

闪亮点击DT后弹出window

Pop up window after clicking on DT in shiny

javascript

r

shiny

action-button

shinybs