I am building a modularized Shiny application that uses shiny, DT, and other libraries to render an interactive datatable. The table includes clickable elements in a specific column, and when clicked, it opens a modal dialog and populates a form using a module. However, I noticed that the observeEvent inside the module gets triggered multiple times — once for every time the datatable cell is clicked.
Here is a minimal example of my app:
library(tidyverse)
library(shiny)
library(DT)
library(shinyGizmo)
library(shinyWidgets)
# Modules
TablaUI <- function(id) {
ns <- NS(id)
tagList(
DTOutput(ns("tabla")),
modalDialogUI(
modalId = ns("ModalEditar"),
title = "",
button = NULL,
easyClose = TRUE,
footer = actionButton(ns("Cerrar_ModalEditar"), "Cerrar"),
FormularioTestUI(ns("Editar"))
)
)
}
TablaServer <- function(id, data) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
# Render the table
output$tabla <- renderDT({
aux1 <- data()
mat <- expand.grid(1:nrow(aux1), 5) %>% as.matrix()
datatable(aux1, escape = FALSE, rownames = FALSE,
selection = list(target = 'cell', mode = "single", selectable = mat),
options = list(dom = "t"))
})
proxy <- dataTableProxy("tabla")
observe({
req(input$tabla_cells_selected)
selected_row <- input$tabla_cells_selected[1]
selected_col <- input$tabla_cells_selected[2]
selected_value <- data()[selected_row, "PerRazSoc"]
if (selected_col == 5) {
showModalUI("ModalEditar")
FormularioTest("Editar", selected_value)
}
proxy %>% selectCells(NULL)
})
})
}
FormularioTestUI <- function(id) {
ns <- NS(id)
tagList(
textInput(ns("RazonSocial"), label = h6("Razon Social"), width = "100%", value = ""),
actionBttn(inputId = ns("LEAD_Editar"), label = "Mensaje", style = "unite", color = "danger", size = "sm", icon = icon("save"), block = TRUE)
)
}
FormularioTest <- function(id, selected_value) {
moduleServer(id, function(input, output, session) {
# Update the form input
updateTextInput(session, "RazonSocial", value = selected_value)
# Observe button click
observeEvent(input$LEAD_Editar, {
showNotification(paste0("Selected: ", selected_value), type = "message", duration = 5)
}, once = TRUE)
})
}
# Data
data_example <- data.frame(
PerRazSoc = c("Company A", "Company B"),
Asesor = c("John", "Jane"),
pct_missing = c(.8, .9),
SacosPotencial = c(11, 20),
MargenPotencial = c(1000, 200)
) %>%
mutate(Detalle = "<span title='Abrir Detalle' style='cursor:pointer'>🔎</span>")
# Main App
ui <- fluidPage(
titlePanel("Modularized App with DT"),
TablaUI("tabla1")
)
server <- function(input, output, session) {
TablaServer("tabla1", data = reactive(data_example))
}
shinyApp(ui, server)
The issue seems to arise from how the observeEvent inside the FormularioTest module is defined. The observeEvent gets re-initialized every time the datatable selection triggers FormularioTest. I expected the once = TRUE argument in observeEvent to prevent this, but it does not solve the problem.
Questions:
After lots of prints in my code I realized module FormularioTest
is instantiated every time the module is called in the DT
click observer.
To solve this, I just call the module FormularioTest
outside the observer using reactive value selected_value <- reactiveVal(NULL)
TablaServer <- function(id, data) {
moduleServer(id, function(input, output, session) {
ns <- session$ns
selected_value <- reactiveVal(NULL)
output$tabla <- renderDT({
aux1 <- data()
mat <- expand.grid(1:nrow(aux1), 5) %>% as.matrix()
datatable(
aux1,
escape = FALSE,
rownames = FALSE,
selection = list(target = "cell", mode = "single", selectable = mat),
options = list(dom = "t")
)
})
proxy <- dataTableProxy("tabla")
observeEvent(input$tabla_cells_selected, {
req(input$tabla_cells_selected)
selected_row <- input$tabla_cells_selected[1]
selected_col <- input$tabla_cells_selected[2]
if (selected_col == 5) {
selected_value(data()[selected_row, "PerRazSoc"]) # Update reactive value
showModalUI("ModalEditar")
}
proxy %>% selectCells(NULL)
})
FormularioTest("Editar", selected_value)
})
}
And changing to reactive values in the button click.
FormularioTest <- function(id, selected_value) {
moduleServer(id, function(input, output, session) {
observe({
req(selected_value())
updateTextInput(session, "RazonSocial", value = selected_value())
})
observeEvent(input$LEAD_Editar, {
showNotification(paste0("Selected: ", selected_value()), type = "message", duration = 5)
})
})
}