Hierarchy Dependent Dropdown


#1

Hi :slight_smile:

I am trying to develop a function for R Shiny, whose purpose is to filter the dropdowns based on a Hierarchy.

I can do it by hardcoding each reactive value and update the dropdown, where the dataframe is filtered by the above dropdowns. But I want to make a more dynamic function, since I use this kind of dropdowns alot!

I am tried to develop a function, see below, but the middle dropdown does not react to changes.

I really hope that someone is able to help me figure this out. :slight_smile:

Many thanks,

Ricko

Minimal example below:

library(shiny)
library(dplyr)

df = data.frame(continent = c(rep("North America", 4), rep("Asia", 4), rep("Europe", 4)),
                country = c(rep("USA", 2), rep("Canada", 2), rep("China", 2), rep("Vietnam", 2), 
                            rep("France", 2), rep("Denmark", 2)),
                city = c("New York", "LA", "Ontario", "Ottawa", "Beijing", "Shanghai", "Hanoi", 
                         "Ho Chi Minh City", "Paris", "Tours", "Copenhagen", "Aarhus"))

HierarchyDependentDropdown = function(inputNames, columnNames, df, input = input, session = getDefaultReactiveDomain()){
  
  # make the inputs into reactive values
  my_reactive <- reactiveValues()
  lapply(1:length(inputNames), function(i){
    observe({
      my_reactive[[inputNames[i]]] = input[[inputNames[i]]]
    })
  })
  
  for(i in 2:length(inputNames)){
    observe({
      
      gg = lapply(1:(i-1), function(x){
        if(!is.null(my_reactive[[inputNames[x]]])){ 
          paste0(columnNames[x], " %in% c('", paste(my_reactive[[inputNames[x]]], collapse = "','"), "')")
        }
      })
      
      where_str = unlist(gg)
      
      tmp = df
      
      if(!is.null(where_str)){
        where_str = paste(where_str, collapse = " & ")
        tmp = df %>% filter_(where_str)
      }

      tmp = tmp %>% 
        select(columnNames[[i]]) %>% 
        distinct_(columnNames[[i]]) %>% 
        arrange_(columnNames[[i]]) %>% 
        pull() %>% 
        as.character()
      updateSelectizeInput(session,
                           inputId = inputNames[i],
                           choices = c("All" = "", tmp))
    })
  }
}

shinyApp(
  ui = basicPage(
    selectizeInput(inputId = "selectcontinent", 
                   label = "Select Continent", 
                   choices = c('All' = "", df %>% distinct(continent) %>% pull() %>% as.character()), 
                   multiple = TRUE)
    ,selectizeInput(inputId = "selectcountry", 
                    label = "Select Country", 
                    choices = c('All' = "", df %>% distinct(country) %>% pull() %>% as.character()), 
                    multiple = TRUE)
    ,selectizeInput(inputId = "selectcity", 
                    label = "Select City", 
                    choices = c('All' = "", df %>% distinct(city) %>% pull() %>% as.character()), 
                    multiple = TRUE)
  ),
  server = function(input, output, session) {
    HierarchyDependentDropdown(inputNames = c("selectcontinent",
                                              "selectcountry",
                                              "selectcity"), 
                               columnNames = c('continent',
                                               'country',
                                               'city'), 
                               df = df, 
                               input = input)
  }
)