Search code examples
rshinyshinydashboardshiny-reactivity

Loading shiny module only when menu items is clicked

Background

Within a modular1 Shiny application, I would like to load module only when menu item on 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 2:

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.

application layout

1 Modularizing Shiny app code

2 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()
Solution

  • 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.

    Edit: if we want to run callModule only once on the first click (just like @UgurDar), we can introduce a blocking variable:

    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)