How to force inputs to take on the same values across modules

Question

I'm working on a shiny dashboard that makes heavy use of shiny modules and my client has asked me to make it so that the same two inputs from my dashboard's various tabs take on the same values regardless of tab. I'm having a huge problem doing this and was able to recreate it using a toy example that you'll find below.

#app.R

library(data.table)
library(shiny)
library(ggplot2)
library(ggthemes)
library(shinythemes)
source("Modules.R")

penguins <<- as.data.table(palmerpenguins::penguins)

ui = uiOutput("ui")
inputs <<- reactiveValues(species = NULL, island = NULL)

server <- function(input, output, session) {
  bill_species_server("tab1")
  flipper_mass_scatter_server("tab2")
  
  output$ui = renderUI({
    fluidPage(
      titlePanel("", "Penguin Dashboard"),
       tabsetPanel(
         tabPanel("Bill Length by Species",
                ui_code("tab1")
        ),
        tabPanel("Flipper Length by Body Mass",
                 ui_code("tab2")
        )
      )
    )
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

#Modules.R

ui_code = function (id) {
  ns = NS(id)
  
  sidebarLayout(position = "left",
    sidebarPanel(
      selectInput(ns("species"), "Choose 1+ species:", choices = penguins[, sort(unique(species))], multiple = TRUE),
      selectInput(ns("island"), "Choose 1+ islands:", choices = penguins[, sort(unique(island))], multiple = TRUE)
    ),
    mainPanel(
      plotOutput(ns("plot"))
    )
  )
}

bill_species_server = function(id) {
  
  moduleServer(id, function(input, output, session) {
    
    observeEvent(inputs$species, ignoreInit = TRUE, ignoreNULL = TRUE, {
      if (length(inputs$species) > 0) {
        updateSelectInput(session = session, inputId = "species", selected = inputs$species)
      }
    })
    
    observeEvent(inputs$island, ignoreInit = TRUE, ignoreNULL = TRUE, {
      if (length(inputs$island) > 0) {
        updateSelectInput(session = session, inputId = "island", selected = inputs$island)
      }
      
    })
    
    output$plot = renderPlot({
      
      if (length(input$species) > 0) {
        penguins = penguins[species %in% input$species]
      }
      
      if (length(input$island) > 0) {
        penguins = penguins[island %in% input$island]
      }
      
      ggplot(penguins) + geom_histogram(aes(x = `bill_length_mm`, fill = species)) + scale_fill_canva(palette = "Striking and energetic")
    })
    
    observeEvent(input$species, ignoreNULL = TRUE, ignoreInit = TRUE, {
      inputs$species = input$species
    })
    
    observeEvent(input$island, ignoreNULL = TRUE, ignoreInit = TRUE, {
      inputs$island = input$island
    })
    
    
  })
  return(inputs)
}

flipper_mass_scatter_server = function (id) {
  

  moduleServer(id, function(input, output, session) {
    
    observeEvent(inputs$species, ignoreInit = TRUE, ignoreNULL = TRUE, {
      if (length(inputs$species) > 0) {
        updateSelectInput(session = session, inputId = "species", selected = inputs$species)
      }
    })
    
    observeEvent(inputs$island, ignoreInit = TRUE, ignoreNULL = TRUE, {
      if (length(inputs$island) > 0) {
        updateSelectInput(session = session, inputId = "island", selected = inputs$island)
      }
      
    })
    
    output$plot = renderPlot({
      
      if (length(input$species) > 0) {
        penguins = penguins[species %in% input$species]
      }
      
      if (length(input$island) > 0) {
        penguins = penguins[island %in% input$island]
      }
      
      ggplot(penguins) + geom_point(aes(x = `flipper_length_mm`, y = body_mass_g, colour = species)) + scale_colour_canva(palette = "Striking and energetic")
    })
    
    observeEvent(input$species, ignoreNULL = TRUE, ignoreInit = TRUE, {
      inputs$species = input$species
    })
    
    observeEvent(input$island, ignoreNULL = TRUE, ignoreInit = TRUE, {
      inputs$island = input$island
    })
  })
  return(inputs)
}

So the two inputs that I'm trying to link in this toy example are species and island. I've set it up so that when someone makes a new selection on either input, an observer should update a global variable which in this case I've labelled inputs. And then if inputs is updated, the other tab should then update its own selectInput.

Weirdly, I find that with this code, if I make my selections kind of slowly, all works just fine! However, the moment that I click 2+ choices in rapid succession, it causes an infinite loop to happen in the current tab where the second choice appears, then disappears, then appears... etc. Conversely, when I have 3 choices selected and try to delete options in rapid succession, it just doesn't let me delete all choices!!

So weird.

Anyone know what the problem is with my code, and how I can force the inputs in both tabs to keep the same values as chosen in the other tabs?

Thanks!

Answer 1

I significantly restructured how I approached this problem and came up with a solution. Basically, I used shinydashboard and decided that I would define the species and island selectInput controls outside of my modules.

The values to those controls were then passed to the modules as reactive objects that were then used to filter the data before the data got plotted. This works so much better now! Have a look at my two files:

#app.R

library(data.table)
library(shiny)
library(ggplot2)
library(ggthemes)
library(shinythemes)
library(shinydashboard)
source("Modules.R")

penguins <<- as.data.table(palmerpenguins::penguins)

ui = dashboardPage(header = dashboardHeader(title = "Penguin Dashboard"),
                    sidebar = dashboardSidebar(
                     sidebarMenu(id = "tabs",
                                 selectInput("species", "Choose 1+ species:", choices = penguins[, sort(unique(species))], multiple = TRUE),
                                 selectInput("island", "Choose 1+ islands:", choices = penguins[, sort(unique(island))], multiple = TRUE),
                                 menuItem("Bill Length by Species", expandedName = "tab1", tabName = "tab1", startExpanded = TRUE,
                                          sliderInput("mass", "Select a range of body masses:", 
                                                      min = penguins[, min(body_mass_g, na.rm=TRUE)],
                                                      max = penguins[, max(body_mass_g, na.rm=TRUE)], 
                                                      value = penguins[, range(body_mass_g, na.rm=TRUE)])
                                          ),
                                 menuItem("Flipper Length by Body Mass", expandedName = "tab2", tabName = "tab2",
                                          checkboxGroupInput("sex", "Choose sex of penguins:", 
                                                             choices = c("male","female")))
                     )),
                     body = dashboardBody(
                       uiOutput("plots")
                       )
)

#inputs <<- reactiveValues(species = NULL, island = NULL)

server <- function(input, output, session) {
  #inputs <- reactiveValues(species=input$species, island=input$island)
  
  in_species = reactive({input$species})
  in_island = reactive({input$island})
  in_mass = reactive({input$mass})
  in_sex = reactive({input$sex})
  
  bill_species_server("tab1", in_species, in_island, in_mass)
  flipper_mass_scatter_server("tab2", in_species, in_island, in_sex)
  
  output$plots = renderUI({
    validate(need(!is.null(input$sidebarItemExpanded), ""))
    
    if (input$sidebarItemExpanded == "tab1") {
      ui_code("tab1")
    } else {
      ui_code("tab2")
    }
    
  })
}

# Run the application 
shinyApp(ui = ui, server = server)

#Modules.R

ui_code = function (id) {
  ns = NS(id)
  
      plotOutput(ns("plot"))
}

bill_species_server = function(id, in_species, in_island, in_mass) {
  
  moduleServer(id, function(input, output, session) {
    
    ns <- session$ns
    
    output$plot = renderPlot({

      if (length(in_species()) > 0) {
        penguins = penguins[species %in% in_species()]
      }

      if (length(in_island()) > 0) {
        penguins = penguins[island %in% in_island()]
      }
      
      penguins = penguins[body_mass_g %between% c(in_mass()[1], in_mass()[2])]
      
      ggplot(penguins) + geom_histogram(aes(x = `bill_length_mm`, fill = species)) + scale_fill_canva(palette = "Striking and energetic")
    })
  })
  
}

flipper_mass_scatter_server = function (id, in_species, in_island, in_sex) {
  

  moduleServer(id, function(input, output, session) {
    

    output$plot = renderPlot({

      if (length(in_species()) > 0) {
        penguins = penguins[species %in% in_species()]
      }
      
      if (length(in_island()) > 0) {
        penguins = penguins[island %in% in_island()]
      }
      
      if (length(in_sex()) > 0) {
        penguins = penguins[sex %in% in_sex()]
      }
      
      ggplot(penguins) + geom_point(aes(x = `flipper_length_mm`, y = body_mass_g, colour = species)) + scale_colour_canva(palette = "Striking and energetic")
    })

  })
  
}