Filtering dataframe with multiple filters based on checkboxGroupInput widget selection in Shiny

shiny
1

Hi,

I need to filter a dataframe based on multiple input values from checkboxGroupInput widgets. I have prepared a Reprex. When filtering based on single selection, is fine but how do I filter based on multiple selection, for example, based on age and hobby. Thank you for your help.

Reprex:

library(shiny)
library(shinyWidgets)

id<-c(1:20)
name<-rep(c("John","Mike","Paul","Thomas","Frank"),4)
age<-rep(c(21:30),2)
hobby<-rep(c("Hockey","Baseball","Swimming","Reading"),5)
zipcode<-rep(c(4800,4801,2025,2024),5)

df<-data.frame(id,name,age,hobby,zipcode)
head(df)

# Define UI for application that draws a histogram
ui <- fluidPage(

    # Application title
    titlePanel("Reprex App"),

    # Sidebar with a slider input for number of bins 
    sidebarLayout(
        sidebarPanel(
          actionButton("update.filter", "Update"),
          br(),
          br(),
          checkboxGroupInput("filter.options","Filters",choices = c("name","age","hobby","zipcode"),
                             selected ="age" ),
          
          sliderInput("age.user", label = h3("Age"), min = 21, max=30,value = 25),
          radioButtons("hobby.user", label = h3("Hobby"),
                       choices = list("Hockey" = "Hockey",
                                      "Baseball" = "Baseball",
                                      "Swimming" = "Swimming",
                                      "Reading"="Reading"), 
                       selected = "Reading"),
          textInput("name.user", label = h3("Name"), value = "Type a name"),
          pickerInput(inputId = 'zip.user',
                      label = 'Zip selection',
                      choices = unique(df$zipcode),
                      options = list(`style` = "btn-info"))
        ),

        # Show a filtered table
        mainPanel(
          h2("Table 1"),  
          DT::dataTableOutput("table.1"),
        )
    )
)

server <- function(input, output) {

  dfx<-eventReactive(input$update.filter,{
  
        if(input$filter.options=="age") {
      
      df[df$age == input$age.user, ]
        
      } else if(input$filter.options=="name"){
        df[df$name == input$name.user, ]
      } else if(input$filter.options=="hobby"){
        df[df$hobby == input$hobby.user, ]
      } else if(input$filter.options=="zipcode"){
        df[df$zipcode == input$zip.user, ]
      }     
  })
    
      

  observeEvent(input$filter_options,
               {
                 message(input$filter_options)
               })
  
  observeEvent(input$age.user,
               {
                 message(input$age.user)
               })
  
  observeEvent(input$name.user,
               {
                 message(input$name.user)
               })
  
  output$table.1 = DT::renderDataTable(
    dfx()
    ,options = list(searching = FALSE, scrollX=TRUE,pageLength = 20))
  
  
}

# Run the application 
shinyApp(ui = ui, server = server)
2

checking against a single value vs checking amonst multiple

(df_ <- data.frame(
  colvar = c("first thing","second thing","third thing"),
  num = 1:3
))


library(tidyverse)
(myselection <- c("first thing"))
df_[df_$colvar == myselection,]

(myselection <- c("first thing","second thing"))
df_[df_$colvar %in% myselection,]

also your if() likely need modification also


if(myselection == "second thing") {print("problem")}
if("second thing" %in% myselection) {print("ok")}
3

Dear nirgrahamuk,
Thank you for your comment, however, it does not work as expected.

This is the server side after following your suggestion:

server <- function(input, output) {

  dfx<-eventReactive(input$update.filter,{
  
  # dfx<-reactive({
    # if(input$fiter_options=="name"){
    #   
    #   df[df$names == input$name.user, ]
    #   
      if("age" %in% input$filter.options ) {
      
      df[df$age == input$age.user, ]
        
      } else if("name" %in% input$filter.options){
        df[df$name == input$name.user, ]
      } else if("hobby" %in% input$filter.options){
        df[df$hobby == input$hobby.user, ]
      } else if("zipcode" %in% input$filter.options){
        df[df$zipcode == input$zip.user, ]
      }     
  })
    
      

   output$table.1 = DT::renderDataTable(
    dfx()
    ,options = list(searching = FALSE, scrollX=TRUE,pageLength = 20))
}

When I select two filters for example age and hobby, click update, what I get is just the filtered table based on age (which is the first condition met).

reprex_behaviour_2
reprex_behaviour_2889×775 48.2 KB

and If I change to this:

server <- function(input, output) {

  dfx<-eventReactive(input$update.filter,{
  

  if( input$filter.options == "age" ) {
    df[df$age == input$age.user, ]
  } else if(input$filter.options == "name"){
    df[df$name == input$name.user, ]
  } else if(input$filter.options == "hobby"){
    df[df$hobby == input$hobby.user, ]
  } else if(input$filter.options == "zipcode"){
    df[df$zipcode == input$zip.user, ]
  #multiple selections
  } else if(c("age","name")%in% input$filter.options){
    df[df$age == input$age.user & df$name == input$name.user , ]
  } else if(c("age","hobby")%in% input$filter.options){
    df[df$age == input$age.user & df$hobby == input$hobby.user , ]
  } else if(c("age","zipcode")%in% input$filter.options){
    df[df$age == input$age.user & df$zipcode == input$zipcode.user , ]
  }     
})
    
 

   output$table.1 = DT::renderDataTable(
    dfx()
    ,options = list(searching = FALSE, scrollX=TRUE,pageLength = 20))
  
  
}

I get the error: the condition has length > 1
What can I do to solve this and being able to use multiple filters based on different user input variables?

Thanks,

4 
c("first thing","second thing") %in% myselection 
all(c("first thing","second thing") %in% myselection )

That said, it can be made more convenient to do this kind of multiple selection by writing some small helper functions and using them. consider this example using your df as a starting point


library(tidyverse) 

# simulating selections in shiny
filtchoice <- c("name","age")
input <- list()
input$name <- c("Mike","Paul")
input$age <- 27
#####

# a helper function; it either gets matches or if the variable isnt in the filterchoice it
# returns TRUE, which is equavalent to allowing all records through the filter
f_ <- function(x){
  if(x %in% filtchoice){
    cur_data() %>% pull(x) %in% input[[x]]
  } else {
    TRUE
  }
}

filter(df,
       f_("name"),
       f_("age"),
       f_("hobby"),
       f_("zipcode")
      )

# simulate addition of another zip code selection ontop of existing selection
filtchoice <- c("name","age","zipcode")
input$zipcode <- "2025"

filter(df,
       f_("name"),
       f_("age"),
       f_("hobby"),
       f_("zipcode")
)
5

Hi nirgrahamuk,
Thanks for the reply.

I have run a simple test:

input.filter.options<-c("age","zipcode")

if(c("age","zipcode")%in% input.filter.options){
print("good")
} else {
  print("not good")
}


if(all(c("age","zipcode")%in% input.filter.options)){
  print("good")
} else {
  print("not good")
}

And here is the outcome:
reprex_behaviour_test
So using the all() works fine, however when I tried in Shiny it was not as simple since there some conditions that are met first. So I switched the order of the conditions from multiple to single and I managed to make it work. Here is the code (later I will refactor):

  dfx<-eventReactive(input$update.filter,{
    
    #multiple filters ----
    if(all(c("age","name")%in% input$filter.options)){
      df[df$age == input$age.user & df$name == input$name.user , ]
    } else if(all(c("age","hobby")%in% input$filter.options)){
      df[df$age == input$age.user & df$hobby == input$hobby.user , ]
    } else if(all(c("age","zipcode")%in% input$filter.options)){
      df[df$age == input$age.user & df$zipcode == input$zipcode.user , ]
    #single filters ----
    } else if( input$filter.options == "age" ) {
      df[df$age == input$age.user, ]
    } else if(input$filter.options == "name"){
      df[df$name == input$name.user, ]
    } else if(input$filter.options == "hobby"){
      df[df$hobby == input$hobby.user, ]
    } else if(input$filter.options == "zipcode"){
      df[df$zipcode == input$zip.user, ]
    }
  })

thanks a lot!
Inti

6

this sort of code :

  if(all(c("age","name")%in% input$filter.options)){
      df[df$age == input$age.user & df$name == input$name.user , ]
    } else if(all(c("age","hobby")%in% input$filter.options)){
      df[df$age == input$age.user & df$hobby == input$hobby.user , ]
    } else if(all(c("age","zipcode")%in% input$filter.options)){
      df[df$age == input$age.user & df$zipcode == input$zipcode.user , ]
    #single filters ----
    } else if( input$filter.options == "age" ) {
      df[df$age == input$age.user, ]
    } else if(input$filter.options == "name"){
      df[df$name == input$name.user, ]
    } else if(input$filter.options == "hobby"){
      df[df$hobby == input$hobby.user, ]
    } else if(input$filter.options == "zipcode"){
      df[df$zipcode == input$zip.user, ]
    }

looks worse to me than this sort:


filter(df,
       f_("name"),
       f_("age"),
       f_("hobby"),
       f_("zipcode")
      )

but if you are happy with your solution , then you are happy. thats great :slight_smile: