Pop up window after clicking on DT in shiny

Question

I am struggling on getting a pop up window after click on an action button that are inside a Data Table. All the buttons has the same id. Could anyone help me on the example below?

Example:

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

I got it to work, but it requires a lot of stuff. First, I made each button unique. You can't duplicate HTML ids. Next, to use Shiny inputs in DataTables you have to unbind using javascript in the callback events. Because of HTML duplication stuff I mentioned before, I created a unique bsModal and plot for each button. I used a lot of lapply. You will also need the DT package. Here is the code:

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