Data not passed through to module inside modularized shiny tabPanel/navbarPage

Question

My reproducible shiny app creates some data which shall be plotted by calling a plot module using lapply. It, therefore, contains the main app, the modularized Page_ui/Page_server, and the Module_ui/Module_server.

It works as a stand-alone app when it is not implemented in the tabPanel/navbarPage. In the latter setting, however, the data is created (which can be observed by the message output of the code) but not passed through the plot module. Why?

The parts in detail:

1. The main app, a navbarPage called from ui and server.

2. The modularized page (tabPanel) for the navbarPage (Page_ui and Page_server) which creates some Data (DataPack, a list with three elements) by clicking the "Load" button and calls the plot module via lapply (inspired by the example from Thomas Roh).

3. The plot module (Module_ui and Module_server) for plotting each list element of DataPack with some statistics created inside the plot module (AnalysedPack).

The code does not work when wrapped in a navbarPage:

library(shiny)
library(TTR)

# Single Plot Module to be repeated using lapply in Page_server
Module_ui <- function(id) {
  ns <- NS(id)
  uiOutput(ns("Plot"))
}



Module_Server <- function(
  input, output, session,
  DataPack, DataSetName, InputButton_GetData) {

  AnalysedPack <- eventReactive(
    InputButtton_GetData(), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <- runMean(DataPack()[[DataSetName]])
      return(AnalysedPack)

    })

  output[['Plot']] <- renderUI({

      fluidRow( renderPlot({
        message(paste("Base_Plot", DataSetName))
        plot(DataPack()[[DataSetName]])
        lines(AnalysedPack(), col = "tomato", lwd = 2)}) )

    })
}






# navbarPage Module as tabPanel
Page_ui <- function(id) {

  ns <- NS(id)

  tabPanel("Charts", fluidPage(
    style = "padding-top: 140px;", 
    div(id = ns("placehere")),

    absolutePanel(
      top = 0, width = "97%", fixed = TRUE,
      div(fluidRow(column(
        6, fluidRow(h4("Data Generation")),
        fluidRow(actionButton(ns("InputButton_GetData"), 
                              "Load", width = "100%"))) )) ) ))

}



Page_server <- function(input, output, session) {

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("----- Creating new DataPack -----")
      n <- round(runif(1, min = 100, max = 500))
      message("Data length:", n)

      DataPack <- NULL
      DataPack$one   <- rnorm(n)
      DataPack$two   <- rnorm(n)^2
      DataPack$three <- sin(rnorm(n)^6)

      return(DataPack)

    })

  InputButton_GetData_rx <-
    reactive(input$InputButton_GetData)

  observeEvent(
    input$InputButton_GetData, {

      lapply(names(DataPack()), function(DataSetName) {

        id <- sprintf('Plot%s', DataSetName)
        message("DataSetName: ", DataSetName)
        message("id: ", id)
        insertUI(
          selector = "#placehere",
          where = "beforeBegin",
          ui = Module_ui(id))

        message("callModule: ", id)
        callModule(
          Module_Server, id,
          DataPack            = DataPack,
          DataSetName         = DataSetName,
          InputButton_GetData = InputButton_GetData_rx) })

    })

}






# Main App with navbarPage
ui <- navbarPage(
  "Navbar!",
  Page_ui("someid"),
  position = "fixed-bottom")

server <- function(input, output, session) {
  callModule(Page_server, "someid")
}

shinyApp(ui, server)

The code works when not wrapped in a navbarPage (paragraphs set in order to compare with problematic code above line by line):

library(shiny)
library(TTR)

# Single Plot Module to be repeated using lapply in Page_server
Module_ui <- function(id) {
  ns <- NS(id)
  uiOutput(ns("Plot"))
}



Module_Server <- function(
  input, output, session,
  DataPack, DataSetName, InputButton_GetData, xlim) {

  AnalysedPack <- eventReactive(c(
    InputButton_GetData()), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <- runMean(DataPack()[[DataSetName]])
      return(AnalysedPack)

    })

  output[['Plot']] <- renderUI({
    # `fluidRow`, `div$tag`, or `taglist` necessary as wrapper for some html object
    fluidRow( renderPlot({ 
      message(paste("Base_Plot", DataSetName))
      plot(DataPack()[[DataSetName]])
      lines(AnalysedPack(), col = "tomato", lwd = 2) }) )

  })
}






# navbarPage Module
Page_ui <- fluidPage(




  style="padding-top: 140px;",
  div(id = "placehere"),

  absolutePanel(
    top = 0, width = "97%", fixed = TRUE,
    div(fluidRow(column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", 
                            "Load", width = "100%"))) )) ) 

)



Page_server <- function(input, output, session) {

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("----- Creating new DataPack -----")
      n <- round(runif(1, min = 100, max = 500))
      message("Data length:", n)

      DataPack <- NULL
      DataPack$one   <- rnorm(n)
      DataPack$two   <- rnorm(n)^2
      DataPack$three <- sin(rnorm(n)^6)

      return(DataPack)

    })

  InputButton_GetData_rx <-
    reactive(input$InputButton_GetData)

  observeEvent(
    input$InputButton_GetData, {

    lapply(names(DataPack()), function(DataSetName) {

      id <- sprintf('Plot%s', DataSetName)
      message("DataSetName: ", DataSetName)
      message("id: ", id)
      insertUI(
        selector = "#placehere",
        where = "beforeBegin",
        ui = Module_ui(id))

      message("callModule: ", id)
      callModule(
        Module_Server, id,
        DataPack            = DataPack,
        DataSetName         = DataSetName,
        InputButton_GetData = InputButton_GetData_rx) })

  })

}



shinyApp(Page_ui, Page_server)

For completeness the code works as well when calling the module sequentially (without lapply):

library(shiny)
library(TTR)

# Single Plot Module to be repeated sequentially
Module_ui <- function(id) {
  ns <- NS(id)
  plotOutput(ns("Plot"))
}



Module_Server <- function(
  input, output, session,
  DataPack, DataSetName, InputButton_GetData, xlim) {

  AnalysedPack <- eventReactive(c(
    InputButton_GetData()), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <- runMean(DataPack()[[DataSetName]])
      return(AnalysedPack)

    })

  output$Plot <- renderPlot({

    message(paste("Base_Plot", DataSetName))
    plot(DataPack()[[DataSetName]])
    lines(AnalysedPack(), col = "tomato", lwd = 2)

  })

}






# navbarPage Module as tabPanel
Page_ui <- function(id) {

  ns <- NS(id)

  tabPanel("Charts", fluidPage(
    style = "padding-top: 140px;", 

    absolutePanel(
      top = 0, width = "97%", fixed = TRUE,
      div(fluidRow(column(
        6, fluidRow(h4("Data Generation")),
        fluidRow(actionButton(ns("InputButton_GetData"), 
                              "Load", width = "100%"))) )) ),
    Module_ui(ns("Plot_1")), Module_ui(ns("Plot_2")), Module_ui(ns("Plot_3")) ))

}



Page_server <- function(input, output, session) {

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("----- Creating new DataPack -----")
      n <- round(runif(1, min = 100, max = 500))
      message("Data length:", n)

      DataPack <- NULL
      DataPack$one   <- rnorm(n)
      DataPack$two   <- rnorm(n)^2
      DataPack$three <- sin(rnorm(n)^6)

      return(DataPack)

    })

  InputButton_GetData_rx <- 
    reactive(input$InputButton_GetData)

  callModule(Module_Server, "Plot_1",
             DataPack                = DataPack,
             DataSetName             = "one",
             InputButton_GetData     = InputButton_GetData_rx)

  callModule(Module_Server, "Plot_2",
             DataPack                = DataPack,
             DataSetName             = "two",
             InputButton_GetData     = InputButton_GetData_rx)

  callModule(Module_Server, "Plot_3",
             DataPack                = DataPack,
             DataSetName             = "three",
             InputButton_GetData     = InputButton_GetData_rx)

}






# Main App
ui <- navbarPage(
  "Navbar!",
  Page_ui("some_ns"),
  position = "fixed-bottom")

server <- function(input, output, session) {
  callModule(Page_server, "some_ns")
}

shiny::shinyApp(ui, server)

Answer 1

Your code using lapply and the navbarPage doesn't generate the UI in the proper namespace, since when using the navbarPage construct your modules are "one level deeper". I added the updated code snippet below.

Relevant change is setting the name of your added UI component using session$ns(id).

library(shiny)
library(TTR)

# Single Plot Module to be repeated sequentially
Module_ui <- function(id) {
  ns <- NS(id)
  plotOutput(ns("Plot"))
}


Module_Server <- function(
  input, output, session,
  DataPack, DataSetName, InputButton_GetData, xlim) {

  AnalysedPack <- eventReactive(
    InputButton_GetData(), {

      message(paste("Analysed Pack", DataSetName))
      AnalysedPack <- runMean(DataPack()[[DataSetName]])
      return(AnalysedPack)

    })

    output$Plot <- renderPlot({
      message(paste("Base_Plot", DataSetName))
      plot(DataPack()[[DataSetName]])
      lines(AnalysedPack(), col = "tomato", lwd = 2)
    })
}



# navbarPage Module as tabPanel
Page_ui <- function(id) {

  ns <- NS(id)

  tabPanel(
    "Charts", 
    fluidPage(
      style = "padding-top: 140px;", 
      div(id = "placehere"),

      absolutePanel(
        top = 0, 
        width = "97%", 
        fixed = TRUE,
        div(
          fluidRow(
            column(
              6, 
              fluidRow(h4("Data Generation")),
              fluidRow(
                actionButton(
                  ns("InputButton_GetData"),
                  "Load", 
                  width = "100%"
                )
              )
            )
          )
        )
      )
    )
  )
}


Page_server <- function(input, output, session) {

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("----- Creating new DataPack -----")
      n <- round(runif(1, min = 100, max = 500))
      message("Data length:", n)

      DataPack <- NULL
      DataPack$one   <- rnorm(n)
      DataPack$two   <- rnorm(n)^2
      DataPack$three <- sin(rnorm(n)^6)

      return(DataPack)
    })

  InputButton_GetData_rx <- 
    reactive(input$InputButton_GetData)

  observeEvent(input$InputButton_GetData, {
    lapply(names(DataPack()), function(DataSetName) {
      id <- sprintf('Plot%s', DataSetName)
      message("DataSetName: ", DataSetName)
      message("id: ", id)
      insertUI(
        selector = "#placehere",
        where = "beforeBegin",
        ui = Module_ui(session$ns(id))
      )

      message("callModule: ", id)
      callModule(
        Module_Server,
        id,
        DataPack            = DataPack,
        DataSetName         = DataSetName,
        InputButton_GetData = InputButton_GetData_rx
      )
    })
  })
}



# Main App
ui <- navbarPage(
  "Navbar!",
  Page_ui("some_ns"),
  position = "fixed-bottom")

server <- function(input, output, session) {
  callModule(Page_server, "some_ns")
}

shiny::shinyApp(ui, server)
#> PhantomJS not found. You can install it with webshot::install_phantomjs(). If it is installed, please make sure the phantomjs executable can be found via the PATH variable.

^{Created on 2020-06-04 by the reprex package (v0.3.0)}