Shiny中点击DT表格时observeEvent多次触发的原因及解决方法

我正在构建一个模块化Shiny应用，使用shiny、DT等库渲染交互式数据表。表格某列包含可点击元素，点击后会打开模态对话框并通过模块填充表单。但发现模块内的observeEvent每次点击数据表单元格都会多次触发——点击多少次就触发多少次。

以下是应用的最小示例代码：

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)

问题似乎源于FormularioTest模块内observeEvent的定义方式。每次数据表选中事件触发FormularioTest时，observeEvent都会重新初始化。我曾期望observeEvent的once=TRUE参数能解决此问题，但并未奏效。

问题 #

1. 为何FormularioTest模块中的observeEvent在每次点击数据表时会多次触发？
2. 如何确保observeEvent仅触发一次，或在多次点击数据表时能正确重置？

解答 #

1. 重复触发的原因

核心问题是每次点击单元格时都会重复调用FormularioTest("Editar", selected_value)，而每次调用moduleServer都会创建一个新的模块实例，同时注册一个新的observeEvent观察者。这些旧的观察者不会被自动销毁，会不断累积——点击N次就会生成N个监听同一个按钮的观察者，所以每次点击按钮时，所有已存在的观察者都会触发，导致通知弹出N次。

once=TRUE只是让单个观察者仅触发一次，但无法阻止新的观察者被反复创建，因此点击多次后，新生成的观察者依然会在按钮点击时触发。

2. 解决方案

需要避免重复初始化模块，改为只初始化一次FormularioTest模块，通过传递反应式值来更新模块内的表单数据，而非每次点击都重新调用模块函数。

修改步骤如下：

步骤1：修改TablaServer，初始化模块并传递反应式值

在TablaServer中创建反应式值存储选中数据，仅初始化一次模块：

TablaServer <- function(id, data) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    # 反应式值：存储当前选中的PerRazSoc
    selected_per_razsoc <- reactiveVal(NULL)
    
    # 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) {
        # 更新反应式值，而非重新调用模块
        selected_per_razsoc(selected_value)
        showModalUI("ModalEditar")
      }
      
      proxy %>% selectCells(NULL)
    })
    
    # 仅初始化一次模块，传递反应式值
    FormularioTest("Editar", selected_per_razsoc)
  })
}

步骤2：修改FormularioTest模块，监听反应式值更新表单

模块接收反应式值，监听它来刷新输入框，observeEvent仅创建一次：

FormularioTest <- function(id, selected_value_r) {
  moduleServer(id, function(input, output, session) {
    # 监听反应式值，更新表单输入
    observeEvent(selected_value_r(), {
      req(selected_value_r())
      updateTextInput(session, "RazonSocial", value = selected_value_r())
    })
    
    # Observe button click：仅创建一个观察者
    observeEvent(input$LEAD_Editar, {
      req(selected_value_r())
      showNotification(paste0("Selected: ", selected_value_r()), type = "message", duration = 5)
    })
  })
}

额外需求：每次模态框内按钮仅触发一次

如果希望每次打开模态框后，按钮仅能触发一次（直到下次打开模态框），可添加触发标记：

FormularioTest <- function(id, selected_value_r) {
  moduleServer(id, function(input, output, session) {
    # 反应式标记：记录按钮是否已触发
    button_triggered <- reactiveVal(FALSE)
    
    # 监听模态框关闭事件，重置标记
    observeEvent(input$Cerrar_ModalEditar, {
      button_triggered(FALSE)
    })
    
    # 监听反应式值，更新表单输入
    observeEvent(selected_value_r(), {
      req(selected_value_r())
      updateTextInput(session, "RazonSocial", value = selected_value_r())
      # 打开模态框时重置触发标记
      button_triggered(FALSE)
    })
    
    # 按钮点击事件：仅在未触发时执行
    observeEvent(input$LEAD_Editar, {
      req(selected_value_r(), !button_triggered())
      showNotification(paste0("Selected: ", selected_value_r()), type = "message", duration = 5)
      button_triggered(TRUE)
    })
  })
}

内容的提问来源于stack exchange，提问作者CamiloYateT