如何使用 R Shiny 将命名空间模块的 UI 干净地注入到主应用程序的 UI 中？

Question

我有两个使用

sidebarPanel()

和

mainPanel()

的 R Shiny 示例文件。一个文件（如下所示）称为“Main App”，另一个文件（也如下所示）称为“Mod1”。我想让 Mod1 成为主应用程序使用的命名空间模块，以添加到其各自的

sidebarPanel()

和

mainPanel()

。我想在维护 Mod1 的

sidebarPanel()

和

mainPanel()

的同时执行此操作，以便我可以与主应用程序分开测试和构建该模块。请注意，为了简单起见，这两个示例是在它们之间没有数据共享的情况下起草的，尽管如果我能弄清楚第一步，那将在稍后进行。

这可能吗？如果可以，该怎么做？同样，Mod1 的 UI 嵌入到主应用程序的 UI 中。

我想我可以在没有

sidebarPanel()

和

mainPanel()

的情况下构建模块，而使用

tagList()

代替，但我需要能够单独运行和测试 Mod1 模块。

这是主应用程序：

ui <- fluidPage(
  sidebarPanel(
    h4(strong("Main App")),
    h5(strong("Sidebar panel shell:"))
  ),
  mainPanel(
    h4(strong("Main App")),
    h5(strong(textOutput("sendMssg1")))
  )
)

server <- function(input, output, session) {
  output$sendMssg1 <- renderText("Main panel shell:")
}

shinyApp(ui, server)

我想用什么作为 Mod1：

ui <- fluidPage(
  sidebarPanel(
    h4(strong("Mod1")),
    h5(strong("Base value:")),
    sliderInput("svc", "", min = 0, max = 10, value = 0)
  ),
  mainPanel(
    h4(strong("Mod1")),
    textOutput("sendMssg2"),
    br(),
    textOutput("result1")
  )
)

server <- function(input, output, session) {
  output$sendMssg2 <- renderText(paste("You input the base value of: ",input$svc))
  
  output$result1 <- renderText({
    paste("Mod 1 Result = base + 10:", input$svc + 10)
  })
}

shinyApp(ui, server)

这个例子展示了我通常如何构建我的模块，其中有数据共享：

library(shiny)

mod1_ui <- function(id) {
  ns <- NS(id)
  textOutput(ns("result1"))
}

mod1_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    observe({
      session$userData$mod1(session$userData$shared() + 10)
    })
    output$result1 <- renderText({
      paste("Mod 1 Result = base + 10:", session$userData$mod1())
    })
  })
}

mod2_ui <- function(id) {
  ns <- NS(id)
  textOutput(ns("result2"))
}

mod2_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    output$result2 <- renderText({
      paste("Mod 2 Result = Mod 1 Result * 2:", session$userData$mod1() * 2)
    })
  })
}

ui <- fluidPage(
  mainPanel(
    h5(strong("Base value:")),
    sliderInput("svc", "", min = 0, max = 10, value = 0),
    mod1_ui("mod1"),
    mod2_ui("mod2")
  )
)

server <- function(input, output, session) {
  session$userData$shared <- reactiveVal(0)
  session$userData$mod1 <- reactiveVal(0)
  
  observeEvent(input$svc, {
    session$userData$shared(input$svc)
  })
  
  mod1_server("mod1")
  mod2_server("mod2")
}

shinyApp(ui, server)

使用我的 MS Paint 技能，合并后的 UI 将如下所示：

Answer 1

我找到了一个非常简单的解决方案。

在 mod1 模块中，您可以创建两个单独的 ui 对象，一个用于侧边栏，一个用于主模块。

mod1.R代码：

library(shiny)
    
mod1_UI_input <- function(id, embed = TRUE) {
  ns <- NS(id)
  
  panel <- tagList(
    h4("Module 1"),
    sliderInput(inputId = ns("slider"), label = NULL, min = 0, max = 10, value = 5)
  )
  
  if (!embed) panel <- panel |> sidebarPanel()
  else panel
  
}

mod1_UI_output <- function(id, embed = TRUE) {
  ns <- NS(id)
  
  panel <- tagList(
    h4("Module 1"),
    textOutput(outputId = ns("num"))
  )
  
  if (!embed) panel <- panel |> mainPanel()
  else panel

}

mod1_server <- function(id) {
  moduleServer(id, function(input, output, session) {
    
    output$num <- renderText(input$slider)
    
  })
}

在您的应用程序用户界面中，您只需在正确的位置调用不同的模块部分即可：

ui <- fluidPage(
  
  sidebarLayout(
    sidebarPanel = sidebarPanel(
      h2("Main App"),
      mod1_UI_input("a")
    ),
    mainPanel = mainPanel(
      h2("Main App"),
      mod1_UI_output("a")
    )
  )
  
)

server <- function(input, output, session) {
  
  mod1_server("a")
  
}

shinyApp(ui, server)

通过使用相同的 id（在本例中为“a”）调用所有模块函数，可以确保服务器连接到所有 ui 部分。

截图： 示例应用程序

您可以在模块 UI 函数中看到的可选参数“embed”用于将它们呈现为简单的 ui 元素或 sidebarPanel 和 mainPanel 元素。这样，您可以通过执行以下操作单独测试模块：

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel = mod1_UI_input("a", embed = FALSE),
    mainPanel = mod1_UI_output("a", embed = FALSE)
  )
)

server <- function(input, output, session) {
  
  mod1_server("a")
  
}

shinyApp(ui, server)