I have an app that uses the concept of modules, where essentially each tabPanel is its own module. I have it set up so that each module reads its own dataset from disc. The problem is that I want be able to have a select input in the module be dynamically populated using that dataset. This is easily achieved but the catch is that when I populate the select input in the module, using updateSelectInput() this triggeres the module data reading to be run when the app loads instead of when module is opened/navigated to.

I've created a small example to illustrate how dat() is run prematurely. In my actual project this is a huge issue because it means all data loads up front rather than when navigated to, making it very slow and innefficient.

Any ideas how to avoid this?

library(shiny)
library(dplyr)

module_ui <- function(id, ...) {
    ns <- NS(id)

    tagList(
        "This is the module UI.",
        selectInput(ns("model"), "Select car model:", choices = NULL),
        textOutput(ns("result"))
        )
}

module_server <- function(input, output, session, ...) {

    dat <- reactive({
        # this is where data would be read from disc
        print("Data reading triggered!")
        out <- rownames_to_column(tbl_df(mtcars), "model")
        out
    })

    output$result <- renderText({
        paste("Miles per gallon is", pull(filter(out, model == input$model), "mpg"))
    })


    observe({
        updateSelectInput(session, inputId = "model", choices = dat()$model)
    })
}

ui <- navbarPage("App Title",
                 tabPanel("Tab A", "This is just a landing page."),
                 tabPanel("Tab B", module_ui(id = "my_module"))
)

server <- function(input, output) {

    callModule(module = module_server, id = "my_module")
}

shinyApp(ui = ui, server = server)

2 Answers

2
ismirsehregal On Best Solutions

Adapted from my answer here (You'll need an id for your navbarPage):

library(shiny)
library(dplyr)
library(tibble)

print(paste("App start:", Sys.time()))

module_ui <- function(id, ...) {
  ns <- NS(id)

  tagList(
    "This is the module UI.",
    selectInput(ns("model"), "Select car model:", choices = NULL),
    textOutput(ns("result"))
  )
}

module_server <- function(input, output, session, ...) {

  dat <- reactive({
    # this is where data would be read from disc
    print(paste(Sys.time(), "Data reading triggered!"))
    out <- rownames_to_column(tbl_df(mtcars), "model")
    out
  })

  output$result <- renderText({
    paste("Miles per gallon is", pull(filter(dat(), model == input$model), "mpg"))
  })

  observe({
    updateSelectInput(session, inputId = "model", choices = dat()$model)
  })
}

ui <- navbarPage("App Title", id = "navbarID",
                 tabPanel("Tab A", "This is just a landing page."),
                 tabPanel("Tab B", module_ui(id = "my_module"))
)

server <- function(input, output) {

  observeEvent({input$navbarID=="Tab B"},{
      callModule(module = module_server, id = "my_module")
  }, once = TRUE, ignoreInit = TRUE)
}

shinyApp(ui = ui, server = server)
0
jde On

Try the following:

  1. Give sidebarMenu and id, eg. id = "tabs"
  2. Make an Observer: test
observeEvent(input$tabs, {
    if(input$tabs == "tabID"){     
        # Do something     
    }     
})   

Substitude "tabID" with the id of the tab that you want the data to load on if its selected.