Inspired by this post, I've written a shiny app with a module for a DT data table with two action buttons on each row.
Without the module the code works, as shown in the original post. Unfortunately, using the module I can't access the buttons id, so I think the problem is that the javascript code cannot handle the namespace provided by the module. Any idea to make it work?
app.R
library(shiny)
library(DT)
source("mymodule.R")
ui <- fluidPage(
shiny::includeScript("script.js"),
mymodule_ui("try")
)
server <- function(input, output, session) {
mymodule_server("try")
}
shinyApp(ui = ui, server = server)
mymodule.R
mymodule_ui <- function(id) {
ns <- NS(id)
div(class = "container",
style = "margin-top: 50px;",
DT::DTOutput(outputId = ns("dt_table"), width = "100%")
)
}
mymodule_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
btns <- lapply(1:32, function(x) {
paste0(
'<div class = "btn-group">
<button class="btn btn-default action-button btn-info" id="edit_',
x, '" type="button" onclick=get_id(this.id)><i class="far fa-pen-to-square"></i></button>
<button class="btn btn-default action-button btn-danger" id="delete_',
x, '" type="button" onclick=get_id(this.id)><i class="fas fa-trash-alt"></i></button></div>'
)
}) |> unlist()
df <- cbind(mtcars, btns)
colnames(df) <- c(colnames(mtcars), "btns")
output$dt_table <- DT::renderDT(df, escape = FALSE)
observeEvent(input$current_id, {
print("Hi!")
})
})
}
script.js
function get_id(clicked_id) {
Shiny.setInputValue("current_id", clicked_id, {priority: "event"});
}
In Shiny.setInputValue()
, you need to include the module id
, e.g. "current_id"
has to become "try-current_id"
.
Extend get_id
in script.js
with a parameter module_id
and include this in the onclick
event which is defined in mymodule.R
.
function get_id(module_id, clicked_id) {
Shiny.setInputValue(module_id.concat('-', "current_id"),
clicked_id,
{priority: "event"});
}
mymodule_ui <- function(id) {
ns <- NS(id)
div(class = "container",
style = "margin-top: 50px;",
DT::DTOutput(outputId = ns("dt_table"), width = "100%")
)
}
mymodule_server <- function(id) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
btns <- lapply(1:32, function(x) {
sprintf(paste0(
'<div class = "btn-group">
<button class="btn btn-default action-button btn-info" id="edit_',
x, '" type="button" onclick=get_id(%s,this.id)><i class="far fa-pen-to-square"></i></button>
<button class="btn btn-default action-button btn-danger" id="delete_',
x, '" type="button" onclick=get_id(%s,this.id)><i class="fas fa-trash-alt"></i></button></div>'
), paste0("'", id, "'"), paste0("'", id, "'"))
}) |> unlist()
df <- cbind(mtcars, btns)
colnames(df) <- c(colnames(mtcars), "btns")
output$dt_table <- DT::renderDT(df, escape = FALSE)
observeEvent(input$current_id, {
print("Hi!")
})
})
}