仅在单击菜单项时加载闪亮模块

Question

背景

在模块化¹闪亮应用程序中，我想仅在单击shinydashboard上的菜单项时加载模块。如果未访问菜单项，我不想加载模块。

基本应用

app.R

# Libs
library(shiny)
library(shinydashboard)

# Source module
source("sample_module.R")

ui <- dashboardPage(
    dashboardHeader(title = "Dynamic sidebar"),
    dashboardSidebar(sidebarMenuOutput("menu")),
    dashboardBody(tabItems(
        tabItem(tabName = "tab_one", h1("Tab One")),
        tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
    ))
)

server <- function(input, output) {

    callModule(sampleModuleServer, "sampleModule")

    output$menu <- renderMenu({
        sidebarMenu(
            menuItem(
                "Menu item 1",
                icon = icon("calendar"),
                tabName = "tab_one"
            ),
            menuItem(
                "Menu item 2",
                icon = icon("globe"),
                tabName = "tab_two"
            )
        )
    })
}

shinyApp(ui, server)

sample_module.R

sampleModuleServer <- function(input, output, session) {
    output$plot1 <- renderPlot({
        plot(mtcars)
    })
}

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

    plotOutput(ns("plot1"))

}

期望的实施

仅当单击相关菜单项时，所需的实现才会加载

sample_module

。在²行：

不要从observeEvent内部调用callModule；将其保持在最高水平。获取返回的反应式表达式，并使用 eventReactive 将其包装在按钮单击中。并使用输出中的 eventReactive 等。

x <- callModule(...)
y <- eventReactive(input$go, x())
output$tbl <- DT::renderDataTable(y())

尝试

app.R

（已修改）

# Libs
library(shiny)
library(shinydashboard)

# Source module
source("sample_module.R")

ui <- dashboardPage(
    dashboardHeader(title = "Dynamic sidebar"),
    dashboardSidebar(sidebarMenuOutput("menu")),
    dashboardBody(tabItems(
        tabItem(tabName = "tab_one", h1("Tab One")),
        tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
    ))
)

server <- function(input, output) {

    eventReactive(eventExpr = input$tab_two,
                  valueExpr = callModule(sampleModuleServer, "sampleModule")
    )

    output$menu <- renderMenu({
        sidebarMenu(
            menuItem(
                "Menu item 1",
                icon = icon("calendar"),
                tabName = "tab_one"
            ),
            menuItem(
                "Menu item 2",
                icon = icon("globe"),
                tabName = "tab_two"
            )
        )
    })
}

shinyApp(ui, server)

问题

应用程序运行但模块未加载。问题：

• 如何正确调用仪表板菜单项上的

  eventReactive

  ？

  tab_item

  似乎没有

  id

  参数在该上下文中相当于

  tabName

  ？
• 链接的讨论是指刷新一张表。我试图找出适用于包含大量界面元素和复杂服务器调用的模块的示例。

单击 菜单项 2 应显示

sample_module.R

文件中的内容。

---

¹ 模块化闪亮应用程序代码

² Google 群组：使用 actionButton 激活模块

---

更新

我尝试使用以下语法显式强制模块进入应用程序环境加载：

eventReactive(eventExpr = input$tab_two,
              valueExpr = callModule(sampleModuleServer, "sampleModule"),
              domain = MainAppDomain
)

哪里

MainAppDomain <- getDefaultReactiveDomain()

Answer 1

编辑：删除 Joe Cheng 的顶级声明：

# Libs
library(shiny)
library(shinydashboard)

# Source module
source("sample_module.R")

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(sidebarMenuOutput("menu")),
  dashboardBody(tabItems(
    tabItem(tabName = "tab_one", h1("Tab One")),
    tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
  ))
)

server <- function(input, output) {
  
  observeEvent(input$tabs,{
    if(input$tabs=="tab_two"){
      callModule(sampleModuleServer, "sampleModule")
    }
  }, ignoreNULL = TRUE, ignoreInit = TRUE)
  
  output$menu <- renderMenu({
    sidebarMenu(id = "tabs",
                menuItem(
                  "Menu item 1",
                  icon = icon("calendar"),
                  tabName = "tab_one"
                ),
                menuItem(
                  "Menu item 2",
                  icon = icon("globe"),
                  tabName = "tab_two"
                )
    )
  })
}

shinyApp(ui, server)

此外，您的

sidebarMenu

需要一个 id 才能访问所选选项卡；请参阅闪亮的仪表板文档。

---

编辑：如果我们想在第一次单击时仅运行

callModule

一次，我们可以引入一个阻塞变量：

library(shiny)
library(shinydashboard)

# Source module
source("sample_module.R")

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(sidebarMenuOutput("menu")),
  dashboardBody(tabItems(
    tabItem(tabName = "tab_one", h1("Tab One")),
    tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
  ))
)

server <- function(input, output, session) {
  
  rv <- reactiveValues(tab_two_loaded = FALSE)
  
  observeEvent(input$tabs,{
    if(!(rv$tab_two_loaded) && input$tabs=="tab_two"){
      callModule(sampleModuleServer, "sampleModule")
      rv$tab_two_loaded <- TRUE
    }
  }, ignoreNULL = TRUE, ignoreInit = TRUE)
  
  output$menu <- renderMenu({
    sidebarMenu(id = "tabs",
                menuItem(
                  "Menu item 1",
                  icon = icon("calendar"),
                  tabName = "tab_one"
                ),
                menuItem(
                  "Menu item 2",
                  icon = icon("globe"),
                  tabName = "tab_two"
                )
    )
  })
}

shinyApp(ui, server)

Answer 2

当您在observeEvent中使用callModule时，每次单击menuItem时它都会运行。您可以简单地调用服务器函数内的模块。仅当您单击相关菜单项时它才会运行。

sampleModuleServer <- function(input, output, session) {
  output$plot1 <- renderPlot({
    message("rendering plot1")
    plot(mtcars)
  })
}

sampleModuleUI <- function(id) {
  ns <- NS(id)
  
  plotOutput(ns("plot1"))
  
}

# Libs
library(shiny)
library(shinydashboard)

# Source module

ui <- dashboardPage(
  dashboardHeader(title = "Dynamic sidebar"),
  dashboardSidebar(sidebarMenuOutput("menu")),
  dashboardBody(tabItems(
    tabItem(tabName = "tab_one", h1("Tab One")),
    tabItem(tabName = "tab_two", sampleModuleUI("sampleModule"))
  ))
)

server <- function(input, output) {
  
  callModule(sampleModuleServer, "sampleModule")
  
  output$menu <- renderMenu({
    sidebarMenu(id = "tabs",
                menuItem(
                  "Menu item 1",
                  icon = icon("calendar"),
                  tabName = "tab_one"
                ),
                menuItem(
                  "Menu item 2",
                  icon = icon("globe"),
                  tabName = "tab_two"
                )
    )
  })
}

shinyApp(ui, server)