rshinydtshinymodules

Why does an observeEvent trigger multiple times when clicking on a DT table in Shiny?


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'>&#128270;</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:

  1. Why does observeEvent in the FormularioTest module get triggered multiple times for every click on the datatable?
  2. How can I ensure that observeEvent only triggers once or resets properly when the datatable is clicked multiple times?

Solution

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