Loading shiny module only when menu items is clicked

问题

Background

Within a modular¹ Shiny application, I would like to load module only when menu item on shinydashboard is clicked. If the menu item is not accessed I wouldn't like to load the module.

Basic application

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

}

Desired implementation

The desired implementation would load sample_module only when the relevant menu item is clicked. On the lines of ²:

Don't call callModule from inside observeEvent; keep it at the top level. Take the reactive expression that's returned, and use eventReactive to wrap it in the button click. And use the eventReactive from your outputs, etc.

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

Attempt

app.R (modified)

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

Problem

Application runs but the module does not load. Questions:

• How to correctly call eventReactive on dashboard menu item? The tab_item does not seem to have id parameter is tabName equivalent in that context?
• The linked discussion refers to refreshing one table. I'm trying to figure out example that will work with modules containing numerous interface element and elaborate server calls.

Clicking on Menu item 2 should display the content from the sample_module.R file.

---

¹ Modularizing Shiny app code

² Google groups: activate module with actionButton

---

Update

I've tried explicitly forcing module into application environment load using the following syntax:

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

where

MainAppDomain <- getDefaultReactiveDomain()

回答1:

Edit: Dropping Joe Cheng's top level statement:

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

Furthermore, your sidebarMenu needs an id to access the selected tabs; please see the shinydashboard documentation.

来源：https://stackoverflow.com/questions/53049659/loading-shiny-module-only-when-menu-items-is-clicked