Simple Shiny Module Example with Dependent Dropdowns and Tab Dependent Condition

shiny-module-example.R

# Load libraries
library(shiny)
library(dplyr)
library(tidyr)
library(ggplot2)
library(palmerpenguins)

# data used for minimium reproducible example (reprex)
df <- penguins %>% 
  tidyr::drop_na() %>% 
  dplyr::mutate(
    species = as.character(species), 
    island = as.character(island),
    year = as.factor(year)
  )

# define module UI for year
yr_picker_ui <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(
      inputId = ns('input1'), 
      label = "Year:",
      choices = "",
      multiple = TRUE
    )
  )
}

# define module UI for island
island_picker_ui <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(
      inputId = ns('input_island'),
      label = 'Island:',
      choices = "",
      multiple = TRUE
    )
  )
}

# define module UI for species
species_picker_ui <- function(id) {
  ns <- NS(id)
  tagList(
    selectInput(
      inputId = ns('input_species'),
      label = 'Species: ',
      choices = "",
      multiple = TRUE
    )
  )
}

# define module server
yr_picker_server <- function(id, r) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    observe({
      val <- isolate(r$year)
      
      if(length(val) < 1) {
        updateSelectInput(
          session = session,
          inputId = 'input1',
          choices = "",
          selected = ''
        )
      } else {
        updateSelectInput(
          session = session,
          inputId = 'input1',
          choices = val,
          selected = val[1]
        )
      }
      
    })

    return(list(user_year = reactive(as.numeric(input$input1))))
    
  })
  
}

island_picker_server <- function(id, r, parent_session) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    observeEvent(req(parent_session$input$nav_tabs == 'Plot'), {
      main_df <- r$dataset
      
      islands <- unique(main_df$island)

      updateSelectInput(
        inputId = 'input_island',
        session = session,
        choices = islands,
        selected = islands[1]
      )
    })
    
    observeEvent(r$year_input, {
      main_df <- r$dataset
      years <- r$year_input

      if(length(years) < 1) {
        updateSelectInput(
          inputId = 'input_island',
          session = session,
          choices = '',
          selected = ''
        )
      } else {
        valid_islands <- main_df %>%
          filter(year %in% c(years)) %>%
          select(island) %>%
          distinct() %>%
          pull(island)

        updateSelectInput(
          inputId = 'input_island',
          session = session,
          choices = valid_islands,
          selected = valid_islands[1]
        )
      }

    })
    
    return(list(user_island = reactive(input$input_island)))
  })
  
}

species_picker_server <- function(id, r) {
  moduleServer(id, function(input, output, session) {
    ns <- session$ns
    
    toListen <- reactive({
      list(a = r$island_input,
           b = r$year_input)
    })
    
    observeEvent(toListen(), {
      
      if(length(toListen()$a) < 1 | length(toListen()$b) < 1) {
        updateSelectInput(
          session = session,
          inputId = 'input_species',
          choices = '',
          selected = ''
        )
      } else {
        
        main_df <- r$dataset
        years <- r$year_input
        islands <- r$island_input
        
        valid_species <- main_df %>%
          filter(year %in% c(years)) %>%
          filter(island %in% c(islands)) %>%
          select(species) %>%
          distinct() %>%
          pull(species)
        
        updateSelectInput(
          inputId = 'input_species',
          session = session,
          choices = valid_species,
          selected = valid_species[1]
        )
      }
    })
    
    return(list(user_species = reactive(input$input_species)))
    
  })
}


# UI
ui <- navbarPage(
  title = "Shiny Modules - Simplified",
  id = 'nav_tabs',
  tabPanel(
    title = 'Data Table',
      sidebarLayout(
        sidebarPanel(
          yr_picker_ui(id = 'choose_year'),
          island_picker_ui(id = 'choose_island'),
          species_picker_ui(id = 'choose_species')
        ),
        mainPanel(
          verbatimTextOutput(
            outputId = 'txt_out'
          ),
          tableOutput(
            outputId = 'dat_out'
          )
        )
      )
  ),
  tabPanel(
    title = "Plot",
    sidebarLayout(
      sidebarPanel(
        island_picker_ui(id = 'choose_island2')
      ),
      mainPanel(
        verbatimTextOutput(
          outputId = 'txt_out2'
        ),
        plotOutput(
          outputId = 'plot1'
        )
      )
    )
  )
)

# Server
server <- function(input, output, session) {
  
  # reactive variable for data
  r <- reactiveValues()
  r$dataset <- df
  
  return_year = yr_picker_server('choose_year', r = r)
  return_island = island_picker_server('choose_island', r = r, parent_session = session)
  return_species = species_picker_server('choose_species', r = r)
  tab_plot_return_island = island_picker_server('choose_island2', r = r, parent_session = session)
  
  observe({
    r$year = r$dataset %>% select(year) %>% distinct() %>% pull()
    r$year_input = return_year$user_year()
    r$island_input = return_island$user_island()
    r$current_tab = input$nav_tabs
  })
  
  #Call modules
  yr_picker_server('choose_year', r = r)
  island_picker_server('choose_island', r = r, parent_session = session)
  species_picker_server('choose_species', r = r)
  island_picker_server('choose_island2', r = r, parent_session = session)
  
  # output fields
  output$txt_out <- renderPrint({
    # return_year$user_year()
    return_island$user_island()
  })
  
  output$dat_out <- renderTable({
    
    # capture input values from the user
    user_year = return_year$user_year()
    user_island = return_island$user_island()
    user_species = return_species$user_species()
    
    df %>%
      dplyr::filter(year %in% c(user_year)) %>%
      dplyr::filter(island %in% c(user_island)) %>%
      dplyr::filter(species %in% c(user_species))
    
  })
  
  output$txt_out2 <- renderPrint({
    r$current_tab
  })
  
  output$plot1 <- renderPlot({
    
    user_island = tab_plot_return_island$user_island()
    
    df_plt <- df %>%
      dplyr::filter(island %in% c(user_island)) %>%
      dplyr::mutate(
        year = as.factor(year)
      )
    
    df_plt %>%
      ggplot(aes(x = year, y = body_mass_g, color = sex)) +
      geom_point()
    
  })
  
  
}


shinyApp(ui, server)