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:

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)