7

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()
Konrad
  • 17,740
  • 16
  • 106
  • 167

1 Answers1

13

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.

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • Thanks very much for showing the interest. Not sure if this does the job. To test, Within `sampleModuleServer ` I've included `stop("Module loaded, crashing...")`. Now the app crashes on start (it does not launch). Whereas to my mind, *it shouldn't* it should only crash if I trigger the event calling this module (clicking on the link). Is that a sensible assumption? – Konrad Nov 21 '18 at 16:30
  • Well, then it seems we need to join the dark side and use observeEvent anyway. - please check my edit. – ismirsehregal Nov 21 '18 at 18:23