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和绘图。我使用了很多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后弹出窗口

1 个答案: