我的应用程序中有以下设置：

• 显示侧栏Panel的UI模块。相应的服务器函数在后端启动一些计算，并以（几乎）任意多个 Dataframe 的列表的形式返回输出。
• 表模块，其显示从UI模块接收的输出。
• 绘图模块，其显示从UI模块接收的输出。

我面临的问题是，我不确定如何允许我的tabs修改对象val并启动模块中的相应事件。此外，类似地，我没有一个清楚的理解，我如何可以使我的userInputPanels与另一个，使他们保持相同时，标签切换。
我在这里收集了一个MWE来说明我的情况：

ui_module.R

# Contrary to its name, this module is also responsible for executing the 
# backend logic when the submit button is pressed
#-------------------------------------------------------------------------------
library(shiny)

inputPanel <- function(id, i18n) {
  ns <- NS(id)
  
  sidebarPanel(
    # in reality here we have A LOT more elements
    actionButton(
      inputId = ns("submit"),
      label = "Submit"
    )
  )
}

inputServer <- function(id) {
  moduleServer(
    id,
    function(input, output, session) {
      ns <- session$ns
      
      # Writing important data into session$userData
      session$userData$submit <- reactive(input$submit)
      
      observe({
        # when data in one user interface changes, the other should update so 
        # that they stay consistent! Thus I need to make the two objects 
        # communicate with one another, but I have not been able to make this
        # work.
      })
      
      val <- reactiveValues(data=NULL)
      observe({
        # In reality, this calls a backend function computing a list of data.frames
        val$data <- lapply(1:sample(1:10, 1), function(i) {
          data.frame(X=rnorm(10), Y=rnorm(10))
        })
      }) %>% bindEvent(input$submit)
      
      return(val)
    }
  )
}

字符串

table_module.R

library(shiny)

tableTabPanel <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title="Tables",
    sidebarLayout(
      # From what I understand, this is how I have to utilize modules when I call them from inside other modules so that session$ns gives me the proper id on the server side of things
      inputPanel(paste(id, "navPanel", sep="-")),
      mainPanel(
        uiOutput(ns("tabsetPanel"))
      )
    )
  )
}

tableServer <- function(id, val_outer=NULL) {
  moduleServer(id, function(input, output, session) {
    
    # I tried doing something like this, but clearly it is not working
    # val_inner <- inputServer("navPanel", i18n_r)
    # observe({
    #   val_outer <- val_inner
    # }) %>% bindEvent(val_inner)
    
    # this way, without the inter-communicability it works:
    val <- inputServer("navPanel")
    
    ns <- session$ns
    observe({
      # I am having a hard time creating a MWE. Please understand that I 
      # have tried quite hard to make this minimal example work, but for some 
      # reason, the tables are not rendered. Still, I assume that the 
      # idea and the root of my problem shall be clear to observers since it 
      # is not related to actually rendering any tables
      
      # !is.null to avoid error on startup when val_outer is empty
      if (!is.null(val$data)) {
        lapply(seq_along(val$data), function(i) {
            output[[paste0("table", i)]] <- renderTable(val$data[[i]])
        })
      }
    }) %>% bindEvent(val)
    
    output$tabsetPanel <- renderUI({
      browser()
      tabPanels <-
        if (!is.null(val$data)) {
          lapply(
            X = seq_along(val$data),
            FUN = function(i) {
              tabPanel(title = paste("Tab", i),
                       tableOutput(ns(paste0("table", i))))
            }
          )
        } else {
          list(NULL)
        }
      
      do.call(tabsetPanel, tabPanels)
    })
    
    return(val)
  })
}

型

*plot_module.R

library(shiny)
library(ggplot2)

plotTabPanel <- function(id) {
  ns <- NS(id)
  
  tabPanel(
    title="Plots",
    sidebarLayout(
      inputPanel(paste(id, "navPanel", sep="-")),
      mainPanel(
        uiOutput(ns("tabsetPanel"))
      )
    )
  )
}

plotServer <- function(id, val_outer) {
  moduleServer(id, function(input, output, session) {
    
    # I tried doing something like this, but clearly it is not working
    val_inner <- inputServer("navPanel", i18n_r)
    observe({
      val_outer <- val_inner
    }) %>% bindEvent(val_inner)
    
    
    ns <- session$ns
    observe({
      # !is.null to avoid error on startup when val_outer is empty
      if (!is.null(val_outer$data)) {
        lapply(seq_along(val_outer$data), function(i) {
          output[[paste0("table", i)]] <-
            renderPlot(ggplot(data=val$data[[i]]) + geom_point(x=X, y=Y))
        })
      }
    })

    output$tabsetPanel <- renderUI({
      tabList <-   
        if (!is.null(val_outer$data)) {
          lapply(seq_along(val_outer$data), function(i) { 
            tabPanel(title = paste("Tab", i),
                     tableOutput(ns(paste0("table", i))))
          })
        } else {
          tabPanel(title = "Sample title")
        }
      
      do.call(tabsetPanel, tabList)
    })

    return(val_outer)
  })
}

型

main.R

library(shiny)

# some reactiveValues containing various fields
val <- reactiveValues(data=NULL)  # and some more values

ui <- navbarPage(
  title = "title",
  
  tableTabPanel("tableTab"),
  # plotTabPanel("plotTab")
)

server <- function(input, output, session) {
  # The idea is to allow the user to access the input panel from both tabs. For this I need to observe, throughout the "lifecycle" of my app, whether changes to val have occured
  val <- tableServer("tableTab", val)
  # val <- plotServer("plotTab", val)
}

shinyApp(ui=ui, server=server)

型