Adding buttons to Shiny DT to pull up modal - r

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)

Answer 1

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)

Answer 2

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)