Reading time ~ 20 minutes ->

Surréaliste! I was developing a new Shiny application and got stuck implementing several `SelectizeInput’ (alias drop-down) in the user interface to filter a data frame.

Seriously, this can be useful if you want to filter a data frame according to all drop-down inputs. More precisely a hierarchical parent-child data frame. E. g:

  1. the choice of a car brand;
  2. the choice of models available for this brand;
  3. engines;

The possible choices for the second and third drop-down must therefore be conditioned by the choice of the previous one. This avoids filtering the table according combinations that do not exist. What does this have to do with Hadley Wickham and Réné Magritte? We will see it later: -)

About SelectizeInput: for those who don’t know this type of input in Shiny, it allows the creation of a drop-down list for just about anything you want. For more information you can consult the thumbnail here: SelectizeInput.

Ready ?

Let’s start by building a data frame of 5 columns and 4 rows to illustrate the situation. Ho yeah, I forgot! We need these 2 packages.

library(tidyverse)
library(shiny)

Magritte

Here we go! I am born in Belgium. You know that little surrealist country so charming. Therefore an opportunity for me to refer to one of the greatest surrealist painters: Réné Magritte and one of his famous painting : The Son of Man (French: Le fils de l’homme). If you don’t know who is this painter, I really invite you to discover him and why not take the opportunity to visit the land of french fries (Whaaaat? French? So surréaliste!).

It is also an opportunity to refer to some of Hadley’s packages that are so attractive but just as surréaliste.

Let’s create a surréaliste data frame:

a_df <- tibble(
     var_one = c("hadley", "charlotte", "rené", "raymond"),
     var_two = c("mutate", "filter", "slice", "spread"),
     var_three = c("an apple", "a pipe", "a cocktail", "a dog"),
     var_four = c("with", "without", "thanks", "out of"),
     var_five = c("tidyr", "magrittr", "purrr", "dplyr")
     )

Let’s print the result.

print(a_df)
## # A tibble: 4 x 5
##   var_one   var_two var_three  var_four var_five
##   <chr>     <chr>   <chr>      <chr>    <chr>   
## 1 hadley    mutate  an apple   with     tidyr   
## 2 charlotte filter  a pipe     without  magrittr
## 3 rené      slice   a cocktail thanks   purrr   
## 4 raymond   spread  a dog      out of   dplyr

Combinaisons

Thanks to the expand.grid() function, we will extend the data frame with all possible combinations. We have 4 values and 5 columns, which will give us a total of 4^5, or 1,024 combinations.

ex_df <- expand.grid(a_df) # create a df with the 64 combinaisons

Let’s check:

head(ex_df, 20)
##      var_one var_two var_three var_four var_five
## 1     hadley  mutate  an apple     with    tidyr
## 2  charlotte  mutate  an apple     with    tidyr
## 3       rené  mutate  an apple     with    tidyr
## 4    raymond  mutate  an apple     with    tidyr
## 5     hadley  filter  an apple     with    tidyr
## 6  charlotte  filter  an apple     with    tidyr
## 7       rené  filter  an apple     with    tidyr
## 8    raymond  filter  an apple     with    tidyr
## 9     hadley   slice  an apple     with    tidyr
## 10 charlotte   slice  an apple     with    tidyr
## 11      rené   slice  an apple     with    tidyr
## 12   raymond   slice  an apple     with    tidyr
## 13    hadley  spread  an apple     with    tidyr
## 14 charlotte  spread  an apple     with    tidyr
## 15      rené  spread  an apple     with    tidyr
## 16   raymond  spread  an apple     with    tidyr
## 17    hadley  mutate    a pipe     with    tidyr
## 18 charlotte  mutate    a pipe     with    tidyr
## 19      rené  mutate    a pipe     with    tidyr
## 20   raymond  mutate    a pipe     with    tidyr

That’s right: 1,024 combinations. However, if we use this data frame as is, we are not in the desired situation because all combinations are available. Whatever the value chosen in the var_one column, the 4 values in the var_two column are right

To simulate a parent-child data frame we will select 40 combinations using the sample_n function which selects rows randomly.

head(sample_n(ex_df, 40), 20)
##      var_one var_two  var_three var_four var_five
## 1     hadley  mutate   an apple     with magrittr
## 2  charlotte  spread a cocktail  without magrittr
## 3  charlotte  filter a cocktail   thanks magrittr
## 4    raymond   slice     a pipe   out of magrittr
## 5       rené  spread a cocktail   thanks    tidyr
## 6     hadley   slice   an apple   thanks magrittr
## 7       rené   slice a cocktail   out of    tidyr
## 8    raymond  mutate      a dog   thanks    tidyr
## 9    raymond   slice      a dog   out of    dplyr
## 10      rené   slice      a dog     with magrittr
## 11 charlotte  mutate     a pipe     with magrittr
## 12      rené  spread      a dog   out of    tidyr
## 13    hadley   slice   an apple   out of    dplyr
## 14 charlotte  mutate      a dog     with    tidyr
## 15 charlotte  filter a cocktail  without    dplyr
## 16 charlotte   slice     a pipe     with magrittr
## 17    hadley  spread      a dog  without    dplyr
## 18    hadley  mutate      a dog   out of    purrr
## 19    hadley  filter      a dog  without    tidyr
## 20    hadley  mutate      a dog   thanks    dplyr

Let’s save this data frame under the name tib. tib? Surréaliste!

tib <- as_tibble(sample_n(ex_df, 40))

UI side?

The first approach we could have is to use the SelectizeInput() function on the UI side of the app to display the drop-downs in the interface.

selectizeInput('var1', 'Select variable 1', choices = c("choose" = "", levels(tib$var_one)))

Painting App 1

Let’s design the UI completely with 3 drop-downs and a table. A little tip: I use as placeholder the text “choose” with value = "". Then the levels available on the tib data frame.

Code:

shinyApp(
  ui = pageWithSidebar(
        headerPanel("Painting 1"),
        sidebarPanel(
          selectizeInput('var1', 'Select variable 1', choices = c("choose" = "", levels(tib$var_one))), 
          selectizeInput('var2', 'Select variable 2', choices = c("choose" = "", levels(tib$var_two))),
          selectizeInput('var3', 'Select variable 3', choices = c("choose" = "", levels(tib$var_three)))
          ),

    mainPanel(
      tableOutput("table")
  )
),

 server = function(input, output, session) {
   
    output$table <- renderTable({ 
       
       head(tib, 10)
       
    })
   
 },

options = list(height = 500)

)

App:

As you can see, the table does not update according the choice of your drop-down values.

Painting App 2

In fact, it makes sense: the table is not filtered. To do this, we will wrap the filtering operation in a reactive() function which will update the table each time a selection is made. To help us we will use the famous magritte pipe %>%. Surréaliste, isnt’it

Code:

shinyApp(
    ui = pageWithSidebar(
        headerPanel("Painting 2"),
        sidebarPanel(
            selectizeInput('var1', 'Select variable 1', choices = c("choose" = "", levels(tib$var_one))),
            selectizeInput('var2', 'Select variable 2', choices = c("choose" = "", levels(tib$var_two))),
            selectizeInput('var3', 'Select variable 3', choices = c("choose" = "", levels(tib$var_three)))
        ),
        
        mainPanel(
            tableOutput("table")
        )
    ),
    
    server = function(input, output, session) {
        
        tab <- reactive({ # <-- Reactive function here
            
            tib %>% 
                filter(var_one == input$var1) %>% 
                filter(var_two == input$var2) %>% 
                filter(var_three == input$var3)
            
        })
        
        output$table <- renderTable({ 
            
            tab()
            
        })
        
    },
    
    options = list(height = 500)
    
)

App:

The table is only filtered if you choose the right combination. This is a problem if we don’t know the possible combos. Choosing a non-existent combination returns nothing.

Painting App 3

To change this behaviour, it is therefore necessary to filter the choices available for drop-down conditionally. To achieve this, we will use the function updateSelectizeInput(). This function allows you to update the list of choices for the targeted drop-downs. Before we need to create 2 reactive expressions named var.choice2 and var.choice3 filtering the tib data frame (according the choices the user did).

Then use these expressions (don’t forget to put () at the end because it’s a reactive expression) to change the values of our drop-downs. The new values are send to the UI each time thanks the observe() function.

Code:

shinyApp(
  ui = pageWithSidebar(
        headerPanel("Painting 3"),
        sidebarPanel(
          selectizeInput('var1', 'Select variable 1', choices = c("choose" = "", levels(tib$var_one))),
          selectizeInput('var2', 'Select variable 2', choices = c("choose" = "", levels(tib$var_two))),
          selectizeInput('var3', 'Select variable 3', choices = c("choose" = "", levels(tib$var_three)))
          ),

    mainPanel(
      tableOutput("table")
  )
),

 server = function(input, output, session) {
   
    tab <- reactive({ 
         
         tib %>% 
         filter(var_one == input$var1) %>% 
         filter(var_two == input$var2) %>% 
         filter(var_three == input$var3)
      
    })
   
    output$table <- renderTable({ 
       
       tab()
      
    })
    
    # Selectize 2 choice's list <---
    var2.choice <- reactive({
                 tib %>% 
                 filter(var_one == input$var1) %>%
                 pull(var_two)
                  })
    
    # Selectize 3 choice's list <---
    var3.choice <- reactive({
                 tib %>% 
                 filter(var_one == input$var1) %>%
                 filter(var_two == input$var2) %>% 
                 pull(var_three)
                  })
    
    # Observe <---
    observe({
      
    updateSelectizeInput(session, "var2", choices = var2.choice())
    updateSelectizeInput(session, "var3", choices = var3.choice())
  
    })
  
 },

options = list(height = 500)

)

App:

It works, but it’s not great. The choices are updated but as soon as you try to select another value for one of the drop-downs, the table displays the rows that no longer correspond to the choice made. So how do we do it?

Server side !

The solution consists in letting the drop-downs be rendered server side. Let’s examine this step by step.

Painting App 4

The first thing to do is to replace the function SelectizeInput() by the function uiOutput(). This function outputs a server’s rendering on the UI. On the server side, to generate the element, we wrap the renderUI() function around the SelectizeInput() function.

Code:

shinyApp(
  ui = pageWithSidebar(
        headerPanel("Painting 4"),
        sidebarPanel(
          uiOutput("select_var1") # <--- Replace your SelectizeInput by uiOutput 
          ),

    mainPanel(
      tableOutput("table")
  )
),

 server = function(input, output, session) {
   
    tab <- reactive({ 
         
         tib %>% 
         filter(var_one == input$var1)
           
    })
   
    # 1st Input rendered by the server <---
    output$select_var1 <- renderUI({
  
    selectizeInput('var1', 'Select variable 1', choices = c("select" = "", levels(tib$var_one)))
  
    })
    
    output$table <- renderTable({ 
       
       tab()
      
    })
    
 },

options = list(height = 500)

)

Courage, we are almost at the end of our journey.

App:

Painting App 5

To complete our drop-down module, we will add the following 4 drop-downs.

Code:

shinyApp(
  ui = pageWithSidebar(
        headerPanel("Painting 5"),
        sidebarPanel(
          uiOutput("select_var1"), 
          uiOutput("select_var2"),
          uiOutput("select_var3"),
          uiOutput("select_var4"),
          uiOutput("select_var5")
          ),

    mainPanel(
      tableOutput("table")
  )
),

 server = function(input, output, session) {
   
    tab <- reactive({ 
         
         tib %>% 
         filter(var_one == input$var1) %>% 
         filter(var_two == input$var2) %>% 
         filter(var_three == input$var3) %>% 
         filter(var_four == input$var4) %>% 
         filter(var_five == input$var5)
           
    })
   
    # 1st Input rendered by the server <--
    output$select_var1 <- renderUI({
  
    selectizeInput('var1', 'Select variable 1', choices = c("select" = "", levels(tib$var_one)))
  
    })
    
    # 2nd Input rendered by the server <--
    output$select_var2 <- renderUI({
  
    selectizeInput('var2', 'Select variable 2', choices = c("select" = "", levels(tib$var_two)))
  
    })
    
    # 3th Input rendered by the server <--
    output$select_var3 <- renderUI({
  
    selectizeInput('var3', 'Select variable 3', choices = c("select" = "", levels(tib$var_three)))
  
    })
    
    # 4th Input rendered by the server <--
    output$select_var4 <- renderUI({
  
    selectizeInput('var4', 'Select variable 4', choices = c("select" = "", levels(tib$var_four)))
  
    })
    
    # 5th Input rendered by the server <--
    output$select_var5 <- renderUI({
  
    selectizeInput('var5', 'Select variable 5', choices = c("select" = "", levels(tib$var_five)))
  
    })
    
    output$table <- renderTable({ 
       
       tab()
      
    })
    
 },

options = list(height = 500)

)

App:

We now have the 5 drop-down. As you can see, you need to know again the right combination to display the result of the filter on the table. Have you found a good combination?

Painting App 6

To fix this, we need to filter the table to keep the choices available at each drop-down. We use the reactive() function again to create an reactive expression that will be used by each drop-down.

choice_var2 <- reactive({
      tib %>% 
      filter(var_one == input$var1) %>% 
      pull(var_two) %>% 
      as.character() #coerced to character to have text and not the number of the factor
})

Let’s do it for each drop-down.

Code:

shinyApp(
  ui = pageWithSidebar(
        headerPanel("Painting 6"),
        sidebarPanel(
          uiOutput("select_var1"), 
          uiOutput("select_var2"),
          uiOutput("select_var3"),
          uiOutput("select_var4"),
          uiOutput("select_var5")
          ),

    mainPanel(
      tableOutput("table")
  )
),

 server = function(input, output, session) {
   
    tab <- reactive({ 
         
         tib %>% 
         filter(var_one == input$var1) %>% 
         filter(var_two == input$var2) %>% 
         filter(var_three == input$var3) %>% 
         filter(var_four == input$var4) %>% 
         filter(var_five == input$var5)
           
    })
   
    output$select_var1 <- renderUI({
  
    selectizeInput('var1', 'Select variable 1', choices = c("select" = "", levels(tib$var_one)))
  
    })
    
    output$select_var2 <- renderUI({
      
      
      choice_var2 <- reactive({
      tib %>% 
      filter(var_one == input$var1) %>% 
      pull(var_two) %>% 
      as.character()
        
      })
      
    selectizeInput('var2', 'Select variable 2', choices = c("select" = "", choice_var2())) # <- put the reactive element here
  
    })
    
    output$select_var3 <- renderUI({
      
      choice_var3 <- reactive({
      tib %>% 
      filter(var_one == input$var1) %>% 
      filter(var_two == input$var2) %>% 
      pull(var_three) %>% 
      as.character()
        
      })
      
    selectizeInput('var3', 'Select variable 3', choices = c("select" = "", choice_var3()))
  
    })
    
    output$select_var4 <- renderUI({
      
      choice_var4 <- reactive({
      tib %>% 
      filter(var_one == input$var1) %>% 
      filter(var_two == input$var2) %>% 
      filter(var_three == input$var3) %>% 
      pull(var_four) %>% 
      as.character()
        
      })
  
    selectizeInput('var4', 'Select variable 4', choices = c("select" = "", choice_var4()))
  
    })
    
    output$select_var5 <- renderUI({
      
      choice_var5 <- reactive({
      tib %>% 
      filter(var_one == input$var1) %>% 
      filter(var_two == input$var2) %>% 
      filter(var_three == input$var3) %>% 
      filter(var_four == input$var4) %>% 
      pull(var_five) %>% 
      as.character()
        
      })  
  
    selectizeInput('var5', 'Select variable 5', choices = c("select" = "", choice_var5()))
  
    })
    
    output$table <- renderTable({ 
       
       tab()
      
    })
    
 },

options = list(height = 500)

)

App:

That’s it! That’s it! I hope you found this article useful. If you have another more effective method, let me know on twitter, I’m interested. And don’t forget : it’s all about surréalisme.

Cheers.