1

I wanted to see if it was possible to take the inputs from one instance of a Shiny App module and apply them as the default inputs for a separate instance of the same module on a different tab. I'm struggling with the right way to ask this question, but I have tried to create a reproducible example below. I have a shiny dashboard with ~5 tabs, each calling the same plotting module.

For example, in the code below I've created a simplified dashboard that generates a plot. If someone clicks to 'Tab Page 1" and changes the plot color to "deeppink", is it possible to now set that input as the default color option when the user clicks to "Tab Page 2"? Or will the user always have to re-select the color input?

I originally used tabs/modules intending to have independence among tabs, but received feedback from a colleague that it would help users navigate my app if they did not have to re-select all the input options as they switch tabs.

I found Some Examples of Getting Modules to communicate with each other, (also here), but have not found a solution that really addresses this issue.

Additional Context: My full app will have a different tab for each of 5 geographic locations. Each location will allow users to select a survey that was completed as well as a species to investigate data trends. So if a user (on tab 1) selects a survey and a species, it would be nice to have these as the first options selected when the user switches to tab 2 (new geographic region). In this way, the user could more quickly compare similar plots among geographic regions.



library(shiny)
library(shinydashboard)



# Module UI for simple plot

dataPlotUI <- function(id) {
  ns <- NS(id) # create namespace for entered ID


  fluidRow(
    box(
      plotOutput(ns("plot.1"), height = 400)
    ),

    box(
      selectInput(
        ns("color.choice"), "Color:",
        c("darkcyan", "darkolivegreen", "deeppink", "lightsalmon2", "slateblue2", "springgreen3")
      ),

      sliderInput(ns("range"), label = "Range", min = 10, max = 100, value = 50)
    ) # end box
  )
}


########################################
########################################
# Module for Server

#
serverModule <- function(input, output, session, site) {
  output$plot.1 <- renderPlot({
    x <- seq(1, input$range, 1) # use slider to set max of x
    y <- x + rnorm(length(x), 0, 3)


    par(mai = c(.6, .6, .1, .1), las = 1, bty = "l")
    plot(y ~ x, pch = 20, col = input$color.choice)
  })
}


########################################
########################################

# UI


ui <- dashboardPage(

  # # Dashboard Header
  dashboardHeader(title = "Menu"),
  #

  dashboardSidebar(
    sidebarMenu(
      id = "sidebar",
      # Icons can be found: https://fontawesome.com/icons?d=gallery&m=free
      menuItem("Tab Page 1", tabName = "tabA"),
      menuItem("Tab Page 2", tabName = "tabB"),
      menuItem("Tab Page 3", tabName = "tabC")
    )
  ), # End Dashboard Sidebar


  # Body of the dashboard
  dashboardBody(

    # Start with overall tabItems
    tabItems(
      tabItem(
        tabName = "tabA",
        dataPlotUI("tab_one")
      ),
      #
      tabItem(
        tabName = "tabB",
        dataPlotUI("tab_two")
      ),

      tabItem(
        tabName = "tabC",
        dataPlotUI("tab_three")
      )
    )
  ) # end dashboard body
)

#######################################
#######################################


# Server
# Call modules


server <- function(input, output, session) {
  callModule(serverModule, "tab_one")
  callModule(serverModule, "tab_two")
  callModule(serverModule, "tab_three")
}




shinyApp(ui = ui, server = server)
Kodiakflds
  • 603
  • 1
  • 4
  • 15

1 Answers1

3

Yes, it is possible. Here's one way of doing it.

The important concepts are that

  1. Modules can return a value (or values).
  2. The main server can monitor the values returned by modules.
  3. Modules can react to changes in other modules via arguments to their server functions. (Or via session$userData: the approach I've taken.)

I think you knew that last one as you have a site argument in the module server, although you don't seem to use it.

So, taking each step in turn...

Allow the module to server to return a value

Add the following lines at the end of the module server function

rv <- reactive({input$color.choice})
return(rv)

This creates a reactive and returns it. Note that you return the reactive itself, not the reactive's value.

Monitor the modules' return values in the main server

Modify the callModule calls to

tab1 <- callModule(serverModule, "tab_one")
tab2 <- callModule(serverModule, "tab_two")
tab3 <- callModule(serverModule, "tab_three")

All I've done here is assign the modules' return values to local variables in the main server function. They're reactives, so we can monitor them. Add the following lines to the main server function:

session$userData$settings <- reactiveValues(chosenColour=NA)
observeEvent(tab1(), {session$userData$settings$chosenColour <- tab1()})
observeEvent(tab2(), {session$userData$settings$chosenColour <- tab2()})
observeEvent(tab3(), {session$userData$settings$chosenColour <- tab3()})

You can put print calls inside each observeEvent to see what's going on. I did that whilst testing. I think session$userData is a much underused feature of shiny. Unsurprisingly, it's a section of the session object that's writable by the user. The main server function and all module server functions share the same session$userData object, so it's a neat way of passing information between modules.

I've assumed that you'll want to do more than just change the colour of the dots in your real world case, so I've created a settings object. I've made it reactive so that modules can react to changes in it.

Make the modules react to changes

Add the following code to the module server function

  observeEvent(
    session$userData$settings$chosenColour, 
    {
      if (!is.na(session$userData$settings$chosenColour)) 
        updateSelectInput(
          session, 
          "color.choice", 
          selected=session$userData$settings$chosenColour
        )
    }
  )

[Again, put print calls in the observeEvent to check what's going on.]

And that's it.

As an aside, it's good practice always to add

ns <- session$ns

as the first line of your module server function. You don't need it right now, but it's likely you will. I've spent many hours chasing down a bug that's been due to "not needing" session$ns. Now I just do it by default to save the pain.

Here's the full listing of your modified MWE.

library(shiny)
library(shinydashboard)

dataPlotUI <- function(id) {
  ns <- NS(id) # create namespace for entered ID
  fluidRow(
    box(plotOutput(ns("plot.1"), height = 400)),
    box(
      selectInput(
        ns("color.choice"), "Color:",
        c("darkcyan", "darkolivegreen", "deeppink", "lightsalmon2", "slateblue2", "springgreen3")
      ),
      sliderInput(ns("range"), label = "Range", min = 10, max = 100, value = 50)
    ) # end box
  )
}

# Module for Server
serverModule <- function(input, output, session, site) {
  ns <- session$ns
  
  output$plot.1 <- renderPlot({
    x <- seq(1, input$range, 1) # use slider to set max of x
    y <- x + rnorm(length(x), 0, 3)
    
    par(mai = c(.6, .6, .1, .1), las = 1, bty = "l")
    plot(y ~ x, pch = 20, col = input$color.choice)
  })
  
  observeEvent(session$userData$settings$chosenColour, {
    if (!is.na(session$userData$settings$chosenColour)) updateSelectInput(session, "color.choice", selected=session$userData$settings$chosenColour)
  })
  
  rv <- reactive({input$color.choice})
  return(rv)
}

# UI
ui <- dashboardPage(
  dashboardHeader(title = "Menu"),
  dashboardSidebar(
    sidebarMenu(
      id = "sidebar",
      # Icons can be found: https://fontawesome.com/icons?d=gallery&m=free
      menuItem("Tab Page 1", tabName = "tabA"),
      menuItem("Tab Page 2", tabName = "tabB"),
      menuItem("Tab Page 3", tabName = "tabC")
    )
  ), # End Dashboard Sidebar
  dashboardBody(
    # Start with overall tabItems
    tabItems(
      tabItem(
        tabName = "tabA",
        dataPlotUI("tab_one")
      ),
      #
      tabItem(
        tabName = "tabB",
        dataPlotUI("tab_two")
      ),
      
      tabItem(
        tabName = "tabC",
        dataPlotUI("tab_three")
      )
    )
  ) # end dashboard body
)

# Server
server <- function(input, output, session) {
  session$userData$settings <- reactiveValues(chosenColour=NA)
  tab1 <- callModule(serverModule, "tab_one")
  tab2 <- callModule(serverModule, "tab_two")
  tab3 <- callModule(serverModule, "tab_three")
  # Module observers
  observeEvent(tab1(), {session$userData$settings$chosenColour <- tab1()})
  observeEvent(tab2(), {session$userData$settings$chosenColour <- tab2()})
  observeEvent(tab3(), {session$userData$settings$chosenColour <- tab3()})
}

shinyApp(ui = ui, server = server)
Limey
  • 10,234
  • 2
  • 12
  • 32
  • Thank you! My real-world app will be more complicated, but this should get me on the right path. One complication is that not each tab has all the same options. So in the example above, if we imagine that the three tabs have generally the same colors to choose from, but a few unique colors too (e.g. species observed at only one location), then I'll have to integrate some sort of error message or select the next choice in the list if it is not available when the user switches tabs. – Kodiakflds Jul 31 '20 at 16:20