Multiple filtering criteria in Shiny

[meena]

Trying to create a data table exploration app. Need help in debugging the filtering in server
Want all the filters to add up in an "AND" manner.
However, if no filters used, the entire dataset should show up.

Would like to add a submitButton() that evaluates the filters all at once instead of everytime an input is changed.

If some filters not used, logic should not consider them.
Any help is appreciated. Thank you!!!

An example of app aiming to develop- https://cevr.shinyapps.io/LeagueTables/

Sample data can be downloaded here-

rstudio/webinars/blob/master/47-introduction-to-shiny/apps/movies/data/movies.Rdata

library(shiny)
library(shinythemes)
library(dplyr)
library(DT)
library(readxl)

load("movies.Rdata")

d_title_type <- sort(unique(movies$title_type))
d_genre <- sort(unique(movies$genre))
d_mpaa_rating <- sort(unique(movies$mpaa_rating))
d_studio <- sort(unique(movies$studio))
min_year <- min(movies$thtr_rel_year)
max_year <- max(movies$thtr_rel_year)

# Define UI for application that draws a histogram
ui <- fluidPage(
                sidebarLayout(
                  sidebarPanel(width = 2,
                               selectizeInput(
                                 inputId = "i_title_type",
                                 label = "Title type:",
                                 choices = d_title_type,
                                 selected = NULL,
                                 multiple = TRUE,
                                 options = list(placeholder = "Begin typing title type...")
                               ),
                               
                               selectizeInput(
                                 inputId = "i_genre",
                                 label = "Genre:",
                                 choices = d_genre,
                                 selected = NULL,
                                 multiple = TRUE,
                                 options = list(placeholder = "Begin typing genre...")
                               ),
                               
                               selectizeInput(
                                 inputId = "i_studio",
                                 label = "Studio:",
                                 choices = d_studio,
                                 selected = NULL,
                                 multiple = TRUE,
                                 options = list(placeholder = "Begin typing studio...")
                               ),
                               
                               selectizeInput(
                                 inputId = "i_mpaa_rating",
                                 label = "MPAA rating:",
                                 choices = d_mpaa_rating,
                                 selected = NULL,
                                 multiple = TRUE,
                                 options = list(placeholder = "Begin typing mpaa rating...")
                               ),
                               
                               sliderInput(
                                 inputId = "i_year",
                                 label = "Year", min = min_year, max = max_year,
                                 value = c(1995, 2000)
                                 
                               ),
                               
                               br(), br(),
                               
                               downloadButton("download", "Download results")

                  ),

                  mainPanel(width = 10,
                            DT::dataTableOutput(outputId = "mtable")
                  )
                )
)


server <- function(input, output) {
  
  mtable <- reactive({
    filter(movies, (title_type %in% input$i_title_type) &
             (genre %in% input$i_genre) &
             (studio %in% input$i_studio) &
             (mpaa_rating %in% input$i_mpaa_rating) &
(year >= input$year[1] & year <= input$year[2])) %>%
      select(title:thtr_rel_year) 
  })
  
  output$mtable <- DT::renderDataTable({
    DT::datatable(data = mtable(), options = list(pageLength = 10),
                  rownames = FALSE, class = 'display', escape = FALSE)
    
  })
  
  output$download <- downloadHandler(
    filename = function() {
      "movie-results.csv"
    },
    content = function(con) {
      write.csv(mtable(), con)
    }
  )
}

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

[pieterjanvc]

Hi,

Evaluating all at once and preventing them to trigger update is easy to accomplish with a button and and observeEvent. The latter has an innate isolate function in it that prevents anything reactive inside to trigger the code if the criteria observed are not met (in this case clicking a button). Here is an example:

library(shiny)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("input1", "Select", choices = 1:10),
      radioButtons("input2", "Choose", choices = c(LETTERS[1:3])),
      actionButton("myButton", "Click to evaluate")
    ),
    mainPanel(
      textOutput("myOutput")
    )
  )
)

server <- function(input, output, session) {
  
  myText = reactiveVal("")
  
  observeEvent(input$myButton, {
    
    myText(paste("You choose", input$input1, "and", input$input2))
    
  })
  
  output$myOutput = renderText({
    myText()
  })
  
}

shinyApp(ui, server)

Hope this helps,
PJ

[bj_bloom]

I have a solution, but it might not be exactly what you're looking for. In order to allow for the "All" option for each filtered variable, I'm using selectInput rather than selectizeInput. I'm not sure how to allow for the option of multiple selections while also having an "All" option in the filtering criteria. Someone else might have a good idea for that. As with most Shiny apps, there are multiple ways of doing this. This is a bit clunky (lots of steps), but the other option (as I see it) is multiple if/else steps in one reactive function. And that has the habit of going wrong occasionally.

I include the choices embedded within the selectInput functions in the UI rather than at the top but you can put it back up there instead. When you're adding an "All" option to a filter you need to convert from a factor to a character, which is what's happening there. I think you also forgot to use the right variable name for the year in the original filter, so I changed that so it would work for me.

library(shiny)
library(shinythemes)
library(dplyr)
library(DT)
library(here)

load(here::here('apps', 'movies', 'movies.RData'))

min_year <- min(movies$thtr_rel_year)
max_year <- max(movies$thtr_rel_year)

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(width = 2,
                 selectInput(
                   inputId = "i_title_type",
                   label = "Title type:",
                   choices = c("All", unique(as.character(movies$title_type))),
                   selected = "All"
                 ),
                 
                 selectInput(
                   inputId = "i_genre",
                   label = "Genre:",
                   choices = c("All", unique(as.character(movies$genre))),
                   selected = "All"
                 ),
                 
                 selectInput(
                   inputId = "i_studio",
                   label = "Studio:",
                   choices = c("All", unique(as.character(movies$studio))),
                   selected = "All"
                 ),

                 selectInput(
                   inputId = "i_mpaa_rating",
                   label = "MPAA rating:",
                   choices = c("All", unique(as.character(movies$mpaa_rating))),
                   selected = "All"
                 ),

                 sliderInput(
                   inputId = "i_year",
                   label = "Year", min = min_year, max = max_year,
                   sep = "",
                   value = c(1995, 2000)

                 ),
                 
                 br(), 
                 
                 actionButton('select', 'Select'),
                 
                 hr(),
                 
                 downloadButton("download", "Download results")
                 
    ),
    
    mainPanel(width = 10,
              DT::dataTableOutput(outputId = "mtable")
    )
  )
)



server <- function(input, output) {
  
  filtered_title_type <- reactive({
    if(input$i_title_type == "All"){
      movies
    } else {
      movies %>%
        filter(title_type == input$i_title_type)
    }
  })
  
  filtered_genre <- reactive({
    if(input$i_genre == "All"){
      filtered_title_type()
    } else {
      filtered_title_type() %>% 
        filter(genre == input$i_genre)
    }
  })
  
  filtered_studio <- reactive({
    if(input$i_studio == "All"){
      filtered_genre()
    } else {
      filtered_genre() %>% 
        filter(studio == input$i_studio)
    }
  })
  
  filtered_rating <- reactive({
    if(input$i_mpaa_rating == "All"){
      filtered_studio()
    } else {
      filtered_studio() %>% 
        filter(mpaa_rating == input$i_mpaa_rating)
    }
  })
  
  filtered_year <- reactive({
    filtered_rating() %>% 
      filter(thtr_rel_year >= input$i_year[1] & thtr_rel_year <= input$i_year[2]) %>% 
      select(title:thtr_rel_year)
  })
  
  fully_filtered <- eventReactive(input$select, {
    filtered_year()
  })
  
  output$mtable <- DT::renderDataTable({
    DT::datatable(data = fully_filtered(), options = list(pageLength = 10),
                  rownames = FALSE, class = 'display', escape = FALSE)
    
  })
  
  output$download <- downloadHandler(
    filename = function() {
      "movie-results.csv"
    },
    content = function(con) {
      write.csv(fully_filtered(), con)
    }
  )
}

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

^{Created on 2019-07-26 by the reprex package (v0.2.1)}

[meena]

Hello @bj_bloom this is a great solution! Thank you so much for helping me with this. I agree, having "All" in selectizeInput would greatly complicate it. For example, what does the output end up if user selects "All + another option"? It was silly of me to add that in!

This is an elegant solution with the multiple reactive() expressions and the eventReactive to delay the computation.

I will now try a solution to remove the "All" option from the selectizeInput and use this solution you have provided with the neat if/else statements.

Thank you so much!!

[meena]

Many thanks to @pieterjanvc for the great idea on using the observeEvent function. Thank you very much for your help!