2

I created an app (condensed example for illustration) in shiny containing a module whose communication does not work properly.

The ui shall create some Data (DataPack) (a list with so far two elements) by clicking the "Load"-button. The data shall then be plotted via the module whereas the x-axis range of each module's plot shall be controlled by a sliderInput of the ui.

Even though the data created is plotted correctly (on the first run only) here are the particular problems I am facing:

  • I assume that the restarting interrupted promise evaluation warning is being created when DataPack isn't created or passed to the module yet. Therefore, I understand the warning when Datapack isn't created yet but not after the first click of the "Load"-button. Is there a way to avoid this? Where does this behavior come from?
  • After having created some Data (DataPack) by clicking the "Load"-button the slider is updated correctly reflecting the (common) length of the data created (n). However, the initial value set (value = c(0, 150)) is passed to the modules' plot whereas the updated value (or any other slider position after) by creating the data (i.e. the actual length) after having clicked the "Load"-button is not. Why?
  • The app stops after the first run making a second click of the "Load"-button not possible anymore. Why?

Thany you!

library(shiny)
library(TTR)

# module interface
Module_ui <- function(id) {

  ns <- NS(id)
  plotOutput(ns("Plot"))

}

# module server
Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack[[DataSetName]],
         xlim = c(xlim[1], xlim[2])) })

}



# app ui
ui <- fluidPage(

  fluidRow(
    column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),

    column(
      6, fluidRow(h4("Update Plot")),
      sliderInput(
        "SliderInput_xAxis",
        label = NULL,
        min = 0,
        max = 150,
        value = c(0, 150),
        animate = TRUE))),

  Module_ui("Plot_1"),

  Module_ui("Plot_2")

)

# app server
server <- function(input, output, session) {

  DataPack <- eventReactive(
    input$InputButton_GetData, {

      message("Creating DataPack")

      n <- round(runif(1, min = 100, max = 500))

      message(n)

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

      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)

      return(DataPack)

    })

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack(),
             DataSetName  = "one",
             xlim         = input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack(),
             DataSetName  = "two",
             xlim         = input$SliderInput_xAxis)

}



shinyApp(ui, server)
Cevior
  • 97
  • 8
  • Alternatively, we could use the "stratégie du petit r" https://rtask.thinkr.fr/communication-between-modules-and-its-whims/ – Aurèle Apr 07 '20 at 08:22

2 Answers2

3

Prefer passing reactives directly to module functions.

Note removed parentheses and inputs wrapped in reactives in callModule(DataPack = DataPack, ....), and accordingly DataPack() instead of DataPack in module function body.

library(shiny)
library(TTR)

# module interface
Module_ui <- function(id) {
  
  ns <- NS(id)
  plotOutput(ns("Plot"))
  
}

# module server
Module_Server <- function(input, output, session,
                          DataPack, DataSetName, xlim) {
  
  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack()[[DataSetName]],
         xlim = c(xlim()[1], xlim()[2])) })
  
}



# app ui
ui <- fluidPage(
  
  fluidRow(
    column(
      6, fluidRow(h4("Data Generation")),
      fluidRow(actionButton("InputButton_GetData", "Load", width = "100%"))),
    
    column(
      6, fluidRow(h4("Update Plot")),
      sliderInput(
        "SliderInput_xAxis",
        label = NULL,
        min = 0,
        max = 150,
        value = c(0, 150),
        animate = TRUE))),
  
  Module_ui("Plot_1"),
  
  Module_ui("Plot_2")
  
)

# app server
server <- function(input, output, session) {
  
  DataPack <- eventReactive(
    input$InputButton_GetData, {
      
      message("Creating DataPack")
      
      n <- round(runif(1, min = 100, max = 500))
      
      message(n)
      
      DataPack <- NULL
      DataPack$one <- rnorm(n)
      DataPack$two <- rnorm(n)^2
      
      updateSliderInput(
        session = session,
        inputId = "SliderInput_xAxis",
        value   = c(1, n),
        min     = 1,
        max     = n)
      
      return(DataPack)
      
    })
  
  SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack,
             DataSetName  = "one",
             xlim         = SliderInput_xAxis_rx)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack,
             DataSetName  = "two",
             xlim         = SliderInput_xAxis_rx)
  
}



shinyApp(ui, server)

Edit: Recommended syntax update for Shiny version > 1.5

Module_Server <- function(id, 
                          DataPack, DataSetName, xlim) {
  moduleServer(id,
    function(input, output, session) {
      output$Plot <- renderPlot({
        message(paste("Plot", DataSetName))
        plot(DataPack()[[DataSetName]],
             xlim = c(xlim()[1], xlim()[2])) })
    }
  )
}

server <- function(input, output, session) {
  DataPack <- eventReactive(input$InputButton_GetData, {
    message("Creating DataPack")
    n <- round(runif(1, min = 100, max = 500))
    message(n)
    DataPack <- NULL
    DataPack$one <- rnorm(n)
    DataPack$two <- rnorm(n)^2
    updateSliderInput(session = session,
      inputId = "SliderInput_xAxis",
      value = c(1, n), min = 1, max = n)
    return(DataPack)
  })
  
  SliderInput_xAxis_rx <- reactive(input$SliderInput_xAxis)
  
  Module_Server("Plot_1",
                DataPack     = DataPack, 
                DataSetName  = "one",
                xlim         = SliderInput_xAxis_rx)
  
  Module_Server("Plot_2",
                DataPack     = DataPack,
                DataSetName  = "two",
                xlim         = SliderInput_xAxis_rx)
  
}
Aurèle
  • 12,545
  • 1
  • 31
  • 49
1

I'm not sure what the app is supposed to do but I think you have to pass the reactive conductor DataPack to the module server, not the value it returns:

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

  output$Plot <- renderPlot({
    message(paste("Plot", DataSetName))
    plot(DataPack()[[DataSetName]], # note the parentheses
         xlim = c(xlim[1], xlim[2])) })

}

  callModule(Module_Server, "Plot_1",
             DataPack     = DataPack, # no parentheses
             DataSetName  = "one",
             xlim         = input$SliderInput_xAxis)

  callModule(Module_Server, "Plot_2",
             DataPack     = DataPack, # no parentheses
             DataSetName  = "two",
             xlim         = input$SliderInput_xAxis)
Stéphane Laurent
  • 75,186
  • 15
  • 119
  • 225