Filtering a data frame with dependent drop down lists in Shiny thanks Magrittr (aka conditional drop down list).
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:
- the choice of a car brand;
- the choice of models available for this brand;
- 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 dplyrCombinaisons
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 combinaisonsLet’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 tidyrThat’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 tidyrLet’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:
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.