### 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.

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    raymond  spread a cocktail  without    purrr
## 2     hadley   slice     a pipe   out of    dplyr
## 3    raymond  spread   an apple   thanks    purrr
## 4       rené  mutate      a dog   thanks    purrr
## 5       rené  mutate   an apple  without    dplyr
## 6    raymond  mutate      a dog  without magrittr
## 7  charlotte  filter     a pipe   out of magrittr
## 8     hadley  spread a cocktail   out of    purrr
## 9    raymond  mutate a cocktail   thanks    dplyr
## 10      rené  filter      a dog   thanks    tidyr
## 11    hadley  spread a cocktail  without    purrr
## 12 charlotte  filter     a pipe  without    tidyr
## 13 charlotte  spread     a pipe   thanks magrittr
## 14      rené   slice a cocktail     with    tidyr
## 15 charlotte   slice     a pipe  without magrittr
## 16   raymond   slice   an apple   out of magrittr
## 17    hadley   slice      a dog     with    dplyr
## 18   raymond  mutate   an apple  without    tidyr
## 19   raymond  filter   an apple   out of magrittr
## 20    hadley  mutate   an apple   thanks    tidyr

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(
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(
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(
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: ## Edit Arnaud Gaborit gave an another solution with the package shinyWidgets. “With the package shinyWidgets, you could use multiple dependent selectizeInput for filtering data.frame’s columns.” The only issue is that the input allows by defaut (this can not be changed) mutiple selections. Code: library(shinyWidgets) shinyApp( ui = pageWithSidebar( headerPanel("Painting 8"), sidebarPanel( selectizeGroupUI( id = "my-filters", inline = FALSE, params = list( var_one = list(inputId = "var_one", title = "Select variable 1", placeholder = 'select'), var_two = list(inputId = "var_two", title = "Select variable 2", placeholder = 'select'), var_three = list(inputId = "var_three", title = "Select variable 3", placeholder = 'select'), var_four = list(inputId = "var_four", title = "Select variable 4", placeholder = 'select'), var_five = list(inputId = "var_five", title = "Select variable 5", placeholder = 'select') ) ) ), mainPanel( tableOutput("table") ) ), server = function(input, output, session) { res_mod <- callModule( module = selectizeGroupServer, id = "my-filters", data = tib, vars = c("var_one", "var_two", "var_three", "var_four", "var_five") ) output$table <- renderTable({
res_mod()
})

},

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.