creating a dynamic filter in Shiny (R)

Question

I am trying to create a shiny app where by the code in the multi conditional filter is dependent on the user input. So if "all" is selected we see everything and if the selected input equals anything else, we only see data for that input.

the if statements insert code into the dplyr filter.

I hope I explained this properly, Any help would be appreciated, see code below:

Server

library(dplyr)
library(ggplot2)
library(shiny)


shinyServer(function(input, output) {


 raw <- diamonds



  output$cutlist <- renderUI({

  cutlist <- sort(unique(as.vector(raw$cut)), decreasing = FALSE)
  cutlist <- append(cutlist, "All", after =  0)
  selectizeInput("cutchoose", "Cut:", cutlist)

 })


  output$colorlist <- renderUI({

colorlist <- sort(unique(as.vector(raw$color)), decreasing = FALSE)
colorlist <- append(colorlist, "All", 0)
selectizeInput("colorchoose", "color:", colorlist)

})


   output$table <- renderDataTable({



   if(input$colorchoose == "All") {

  filt1 <- quote(color != "@?><")


} else {

  filt1 <- quote(color == input$colorchoose) 

}


if (input$cutchoose == "All") {

  filt2 <- quote(cut != "@?><")


} else {

  filt2 <- quote(cut == input$cutchoose)

}



  raw %>%
  filter_(filt1) %>%
  filter_(filt2)


   })

   })

UI

 shinyUI(fluidPage(

 # Application title
 titlePanel("Dynamic Filter Test App"),


  sidebarLayout(
   sidebarPanel(
   uiOutput("cutlist"),
   uiOutput("colorlist")
   ),


mainPanel(
  dataTableOutput("table")
   )
  )
 ))

console

  Warning: Error in if: argument is of length zero
  Stack trace (innermost first):
  79: renderDataTable [D:\Independent Learning\R 
       code\dynamFilter/server.R#44]
  78: func
  77: origRenderFunc
   76: output$table
    1: runApp

Answer 1

This works for me:

output$table <- renderDataTable({

    req(input$colorchoose)
    req(input$cutchoose)
    if(input$colorchoose == "All") {

      filt1 <- quote(color != "@?><")


    } else {

      filt1 <- paste0("color == ","'",input$colorchoose,"'") 

    }


    if (input$cutchoose == "All") {

      filt2 <- quote(cut != "@?><")


    } else {

      filt2 <- paste0("cut == ","'",input$cutchoose,"'")

    }



    raw %>%
      filter_(filt1) %>%
      filter_(filt2)


  })

The req statments in the beginning prevents the renderDataTable to be fully evaluted untill the inputs are properly initliezed. The second problem was that the input variable didn't seem to be in the scope for the dynamic evaluation of filter, hence I changed the statement to include the value of these variables rather then thier names.

Answer 2

I had a similar error once. I think the cause is that the renderUI expressions aren't necessarily evaluated in time to produce the input values you need for your if statements. Since there isn't really any reactive value in your renderUI expressions for the selectInput() s, you can just put those in the ui script and take them out of the server script.

This works for me:

library(dplyr)
library(ggplot2)
library(shiny)

raw <- diamonds
cutlist <- sort(unique(as.vector(raw$cut)), decreasing = FALSE) %>%
  append("All", after =  0)
colorlist <- sort(unique(as.vector(raw$color)), decreasing = FALSE) %>%
  append("All", 0)

server <- function(input, output) {
  output$table <- renderDataTable({
    if(input$colorchoose == "All") { 
      filt1 <- quote(color != "@?><")
      } else { filt1 <- quote(color == input$colorchoose) }
    if (input$cutchoose == "All") { 
      filt2 <- quote(cut != "@?><")
      } else { filt2 <- quote(cut == input$cutchoose) }
    filter_(raw, filt1) %>% filter_(filt2) } ) }

ui <- shinyUI(fluidPage(
  titlePanel("Dynamic Filter Test App"),
  sidebarLayout(
    sidebarPanel(
      selectizeInput("cutchoose", "Cut:", cutlist),
      selectizeInput("colorchoose", "color:", colorlist) ),
    mainPanel( dataTableOutput("table") ) ) ) )

shinyApp(ui = ui, server = server)