Adding buttons to Shiny DT to pull up modal

Question

I am trying to add a column of buttons in my datatable that when clicked will pull up a modal but I am having trouble using the examples I found online here and here.

Some of my requirements:

Needs to work with an unknown number of rows in the dataset (could be 5, could be 10, could be 500)
Each button needs to be unique id which I can use to reference the row (in the example you can see I am pulling in the row number into the modal - real life I am using the row number to subset my data and actually put information in the modal)

Code:

library(shiny)
library(shinydashboard)
library(DT)

ui = dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    DTOutput('x1'),
    verbatimTextOutput("test")
    )
    )

server = function(input, output) {

  ##DATA TABLE WHERE I NEED A BUTTON##

  output$x1 = renderDT(
    iris,
    selection = 'single',
    options = list(
    )
  )

  ##MODAL CALLED BASED ON BUTTON CLICK

  observeEvent(input$x1_cell_clicked, {

    row = input$x1_cell_clicked$row

    if (is.null(row) || row == '') {} else{

      showModal(modalDialog(
        title = paste0("Timeline!",row),
        size = "s",
        easyClose = TRUE,
        footer = NULL
      ))
    }

  })

  output$test <- renderPrint({
    input$x1_cell_clicked$row
  })

}

shinyApp(ui, server)

score 5 · Accepted Answer · answered Nov 12 '19 at 17:30

In your comment, you asked for the case of multiple datatables. Is it what you want ?

library(shiny)
library(DT)

button <- function(tbl){
  function(i){
    sprintf(
      '<button id="button_%s_%d" type="button" onclick="%s">Click me</button>', 
      tbl, i, "Shiny.setInputValue('button', this.id);")
  }
}

dat1 <- cbind(iris, 
              button = sapply(1:nrow(iris), button("tbl1")), 
              stringsAsFactors = FALSE)
dat2 <- cbind(mtcars, 
              button = sapply(1:nrow(mtcars), button("tbl2")), 
              stringsAsFactors = FALSE)

ui <- fluidPage(
  fluidRow(
    column(
      width = 6,
      DTOutput("tbl1", height = "500px")
    ),
    column(
      width = 6,
      DTOutput("tbl2", height = "500px")
    )
  )

)

server <- function(input, output){

  output[["tbl1"]] <- renderDT({
    datatable(dat1, escape = ncol(dat1)-1, fillContainer = TRUE)
  })

  output[["tbl2"]] <- renderDT({
    datatable(dat2, escape = ncol(dat2)-1, fillContainer = TRUE)
  })

  observeEvent(input[["button"]], {
    splitID <- strsplit(input[["button"]], "_")[[1]]
    tbl <- splitID[2]
    row <- splitID[3]
    showModal(modalDialog(
      title = paste0("Row ", row, " of table ", tbl, " clicked"),
      size = "s",
      easyClose = TRUE,
      footer = NULL
    ))
  })
}

shinyApp(ui, server)

This work great and was very helpful for my app. However, the buttons only work once. If you click a button, then click outside of the modal to close it, then click the same button again it doesn't work. Is there a way to make the button work every time it is clicked? — jim616, Aug 06 '22 at 17:50
@jim616 Try `Shiny.setInputValue('button', this.id, {priority: 'event'})`. — Stéphane Laurent, Aug 06 '22 at 18:00

Kevin · Answer 2 · 2019-11-12T18:11:12.947

Was able to figure it out using this.

library(shiny)
library(shinydashboard)
library(DT)

ui = dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    DTOutput('x1'),
    verbatimTextOutput("test")
    )
    )

server = function(input, output) {

  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  iris_rows <- nrow(iris)

  iris$Timeline = shinyInput(actionButton, iris_rows, 'button_', label = "Timeline", onclick = 'Shiny.setInputValue(\"select_button\", this.id, {priority: \"event\"})' )


  ##DATA TABLE WHERE I NEED A BUTTON##

  output$x1 = renderDT(
    iris,
    selection = 'single',
    escape = FALSE,
    options = list(
    )
  )

  ##MODAL CALLED BASED ON BUTTON CLICK

  observeEvent(input$select_button, {

    row <- as.numeric(strsplit(input$select_button, "_")[[1]][2])

    if (is.null(row) || row == '') {} else{

      showModal(modalDialog(
        title = paste0("Timeline!",row),
        size = "s",
        easyClose = TRUE,
        footer = NULL
      ))
    }

  })

  output$test <- renderPrint({
    as.numeric(strsplit(input$select_button, "_")[[1]][2])
  })

}

shinyApp(ui, server)

Code with multiple data tables to show a separate answer than the one chosen.

library(shiny)
library(shinydashboard)
library(DT)

ui = dashboardPage(
  dashboardHeader(),
  dashboardSidebar(),
  dashboardBody(
    DTOutput('x1'),
    DTOutput('x2'),
    verbatimTextOutput("test")
    )
    )

server = function(input, output) {

  shinyInput <- function(FUN, len, id, ...) {
    inputs <- character(len)
    for (i in seq_len(len)) {
      inputs[i] <- as.character(FUN(paste0(id, i), ...))
    }
    inputs
  }

  iris2 <- iris

  iris_rows <- nrow(iris)
  iris$Timeline = shinyInput(actionButton, iris_rows, 'button_x1_', label = "Timeline", onclick = 'Shiny.setInputValue(\"select_button1\", this.id, {priority: \"event\"})' )

  iris2_rows <- nrow(iris2)
  iris2$Timeline = shinyInput(actionButton, iris2_rows, 'button_x2_', label = "Timeline", onclick = 'Shiny.setInputValue(\"select_button2\", this.id, {priority: \"event\"})' )


  ##DATA TABLE WHERE I NEED A BUTTON##

  output$x1 = renderDT(
    iris,
    selection = 'single',
    escape = FALSE,
    options = list(
    )
  )

  output$x2 = renderDT(
    iris2,
    selection = 'single',
    escape = FALSE,
    options = list(
    )
  )


  ##MODAL CALLED BASED ON BUTTON CLICK

  observeEvent(input$select_button1, {

    row <- as.numeric(strsplit(input$select_button1, "_")[[1]][3])

    if (is.null(row) || row == '') {} else{

      showModal(modalDialog(
        title = paste0("Timeline!",row),
        size = "s",
        easyClose = TRUE,
        footer = NULL
      ))
    }

  })

  observeEvent(input$select_button2, {

    row <- as.numeric(strsplit(input$select_button2, "_")[[1]][3])

    if (is.null(row) || row == '') {} else{

      showModal(modalDialog(
        title = paste0("Timeline!",row),
        size = "s",
        easyClose = TRUE,
        footer = NULL
      ))
    }

  })

  output$test <- renderPrint({
    as.numeric(strsplit(input$select_button1,"_")[[1]][3])
  })

}

shinyApp(ui, server)

You beat me... I was going to post an answer but this is essentially the same. Note that `if (is.null(row) || row == '') {} else{` is not necessary. — Stéphane Laurent, Nov 12 '19 at 16:13
I am looking now that if I have multiple datatables, what needs to change. If you want to post an answer to that, more than happy to accept. — Kevin, Nov 12 '19 at 16:40

Adding buttons to Shiny DT to pull up modal

2 Answers2

Linked