为什么在Shiny中点击DT表会多次触发observeEvent？

Question

我正在构建一个模块化的 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只触发一次或重置 多次点击数据表时是否正确？

Answer 1

在我的代码中进行大量打印之后，我意识到每次在

FormularioTest

单击观察器中调用模块时都会实例化模块

DT

。

为了解决这个问题，我只需使用无功值在观察者外部调用模块

FormularioTest

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

并在单击按钮时更改为无功值。

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