当尝试通过多个级别的子模块将价值引入 UI 时，会出现无限循环

Question

我在闪亮的 R 应用程序中的以下代码中遇到了无限循环（该代码是一个最小的示例，在我更大的实际应用程序中重现了该问题）。 该代码将单击的按钮的命名空间附加到

verbatimTextOutput

。

这里的关键是将值（在本例中通过按钮单击触发）从

submodule

转移到

module

到

ui

的级别。我尝试从模块内部返回反应，但无法避免无限循环。请建议应修复哪些内容才能正常运行。

谢谢。

library(shiny)

ui <- fluidPage(
  textInput("text_input", "Input text"),
  verbatimTextOutput("text_output"),
)

server <- function(input, output, session) {

  updated_text <- reactiveVal()

  observeEvent(input$text_input, {
    req(input$text_input)
    showModal(modalDialog(
      title = "Title",
      size = "l",
      module_ui("module"),
      footer = modalButton("Close")
    ))
    # Update the text with the module result
    updated_text(module_server("module", input$text_input))
  })

  output$text_output <- renderText(updated_text())
}

module_ui <- function(id) {
  ns <- NS(id)

  fluidPage(
    uiOutput(ns("module"))
  )
}

module_server <- function(id, input_text) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      module_rv <- reactiveValues(text = "")

      output$module <- renderUI({
        do.call(navlistPanel,
                c(id = ns("navlist"),
                  lapply(X = 1:3,
                         FUN = function(x) {
                           submodule_return_value <- submodule_server(x)
                           # Update module text with submodule result when button is clicked
                           module_rv$text <- submodule_return_value
                           #create submodule UI
                           submodule_ui(ns(x))
                         })
                )
        )
      })

      # Append the value returned by submodule stored in the reactive value
      return(paste(input_text, "__", module_rv$text))
    }
  )
}

submodule_ui <- function(id) {
  ns <- NS(id)

  tabPanel(title = paste("Title", id),
           uiOutput(ns("submoduleUI"))
  )
}

submodule_server <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns

      # Reactive value to store the value to be returned by submodule
      submodule_rv <- reactiveVal()

      output$submoduleUI <- renderUI({
        do.call(tabsetPanel,
                c(id = ns("tabset"),
                  lapply(X = 1:3,
                         FUN = function(x) {
                           if (x == 1) {
                             tabPanel(paste("Tab", ns(x)),
                                      actionButton(ns("bttn"), paste("Button", ns(x))))
                           } else {
                             tabPanel(paste("Tab", ns(x)),
                                      verbatimTextOutput(ns(paste0(x,"-verb"))))
                           }
                         })
                )
        )
      })

      # When button is clicked, return namespace with the input
      observeEvent(input$bttn, {
        submodule_rv(ns(input$bttn))
      })

      return(submodule_rv())
    }
  )
}

shinyApp(ui, server)

Answer 1

第 1 步 - 调试

向不同的服务器功能添加跟踪，例如：

cat("Launch server \n")

点击按钮后控制台输出：

Launch server
Launch module_server 
Launch submodule_server
Launch submodule_server
Launch submodule_server
Launch submodule_server
Launch submodule_server
Launch submodule_server
...

从那里看来

submodule_server

已启动多次（每次启动新实例时都会触发子模块

observeEvent

）。

步骤 2 - 解决方案

我认为一种方法是在主服务器级别创建一个

reactiveVal

对象 并将其引用传递给模块/子模块。

我建议阅读“圣经”来理解它：高级R

通过这样做，

reactiveVal

对象的内容（值）将被更新 仅在子模块服务器级别，并在主服务器级别使用。

这背后的整个想法是将模块/子模块服务器函数的调用（启动）与它的“输出”（在它们内部计算的值）的使用分开。

此外，主

input$text_input

值也不会发送到模块，因为我们可以 现在将其与主服务器中

reactiveVal

对象的内容连接起来。

library(shiny)

# -- main ui
ui <- fluidPage(
  textInput("text_input", "Input text"),
  verbatimTextOutput("text_output"))


# -- main server
server <- function(input, output, session) {
  
  # -- reactive to pass to module / submodule
  updated_text <- reactiveVal(NULL)
  
  # -- launch module server
  # send the reference of the reactiveVal as argument (not it's value)
  module_server("module", updated_text)
  
  # -- observe main btn & display modal
  observeEvent(input$text_input, {
    req(input$text_input)
    showModal(modalDialog(
      title = "Title",
      size = "l",
      module_ui("module"),
      footer = modalButton("Close")))})
  
  # -- main text output
  # it will be updated each time the content of the reactiveVal is updated
  # by the submodule
  output$text_output <- renderText(
    paste(input$text_input, "__", updated_text()))
  
}


# -- module ----

module_ui <- function(id) {
  ns <- NS(id)
  
  fluidPage(
    uiOutput(ns("module"))
  )
}


module_server <- function(id, updated_text) {
  moduleServer(
    id,
    function(input, output, session) {
      
      ns <- session$ns
      
      # launch submodule instances & update module ui
      output$module <- renderUI({
        do.call(navlistPanel,
                c(id = ns("navlist"),
                  lapply(X = 1:3,
                         FUN = function(x) {
                           
                           # launch submodule server & pass again the 
                           # reference of the reactiveVal
                           submodule_server(x, updated_text)
                           
                           #create submodule UI
                           submodule_ui(ns(x))})))})
      
    }
  )
}


# -- sub module ----

submodule_ui <- function(id) {
  ns <- NS(id)
  
  tabPanel(title = paste("Title", id),
           uiOutput(ns("submoduleUI"))
  )
}


submodule_server <- function(id, updated_text) {
  moduleServer(
    id,
    function(input, output, session) {
      
      ns <- session$ns

      # build submodule ui
      output$submoduleUI <- renderUI({
        do.call(tabsetPanel,
                c(id = ns("tabset"),
                  lapply(X = 1:3,
                         FUN = function(x) {
                           if (x == 1) {
                             tabPanel(paste("Tab", ns(x)),
                                      actionButton(ns("bttn"), paste("Button", ns(x))))
                           } else {
                             tabPanel(paste("Tab", ns(x)),
                                      verbatimTextOutput(ns(paste0(x,"-verb"))))}})))})
      
      
      # When button is clicked, update the reactiveVal
      # this will trigger the observeEvent in the main server :)
      observeEvent(input$bttn, {
        updated_text(ns(input$bttn))})
      
    }
  )
}

shinyApp(ui, server)

补充评论

同样的方法（使用反应对象的引用）也将 为模块服务器返回值工作。模块可以返回的引用 将在调用级别使用的反应式。

我只是觉得与级联子模块的返回值相比，上述解决方案使代码更容易阅读。