Filter data using varSelectInput in Shiny?

Viewed 190

I'd like to use the user-selected variables to filter (and then plot) data. But I'm getting an error that 'list' object cannot be coerced to type 'double'. Here's a dummy example where I'm trying to say: "If user selects "gear" from the list of variables, show a histogram of horsepower for all cars where gear = 4".

library(shiny)

mtcars_cols <- mtcars %>% select(gear, carb)

# Define UI for application that draws a histogram
ui <- fluidPage(
   
   # Application title
   titlePanel("Motor Car Trend Road Tests"),
   
   # Sidebar 
   sidebarLayout(
      varSelectInput("variables", 
                     "Select variables: ", 
                     mtcars_cols,
                     multiple = TRUE),
      
      # Show a plot of the generated distribution
      mainPanel(
         plotOutput("distPlot")
      )
   )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
   
   output$distPlot <- renderPlot({
      dt <- mtcars %>%
        filter(!!!input$variables == 4)
      
      bins <- seq(min(x), max(x), length.out = 10 + 1)
      
      # draw the histogram with the specified number of bins
      hist(dt$hp, breaks = bins, col = 'darkgray', border = 'white')
   })
}

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

I think it is important to differentiate between varSelectInput with multiple = TRUE and multiple = FALSE. Lets start with the latter one (have a look at the console which prints the intermediate steps). With only one variable input$variables is a name. So we can just use !! input$variables == 4 inside dplyr::filter.

library(shiny)
library(dplyr)

mtcars_cols <- mtcars %>% select(gear, carb)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Motor Car Trend Road Tests"),
  
  # Sidebar 
  sidebarLayout(
    varSelectInput("variables", 
                   "Select variables: ", 
                   mtcars_cols,
                   multiple = FALSE),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  output$distPlot <- renderPlot({
    
    print(input$variables)
    
    dt <- mtcars %>%
      filter(!! input$variables == 4)
    
    print(dt)

    bins <- seq(min(dt$hp), max(dt$hp), length.out = 10 + 1)
    
    # draw the histogram with the specified number of bins
    hist(dt$hp, breaks = bins, col = 'darkgray', border = 'white')
  })
}

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

Things are different, when we have multiple variables. Here input$variables is a list of names. If we want to filter all rows where all selected variables are equal 4 a good way is to create a list of expressions with purrr::map and bquote. We can use this list of expressions in dplyr::filter like !!! expr_ls.

library(shiny)
library(dplyr)

mtcars_cols <- mtcars %>% select(gear, carb)

# Define UI for application that draws a histogram
ui <- fluidPage(
  
  # Application title
  titlePanel("Motor Car Trend Road Tests"),
  
  # Sidebar 
  sidebarLayout(
    varSelectInput("variables", 
                   "Select variables: ", 
                   mtcars_cols,
                   multiple = TRUE),
    
    # Show a plot of the generated distribution
    mainPanel(
      plotOutput("distPlot")
    )
  )
)

# Define server logic required to draw a histogram
server <- function(input, output) {
  
  output$distPlot <- renderPlot({
    
    req(input$variables)
    print(input$variables)
    
    expr_ls <- purrr::map(input$variables, ~ bquote(.(.x) == 4))
    
    dt <- mtcars %>%
      filter(!!! expr_ls)

    print(dt)

    bins <- seq(min(dt$hp), max(dt$hp), length.out = 10 + 1)

    # draw the histogram with the specified number of bins
    hist(dt$hp, breaks = bins, col = 'darkgray', border = 'white')
  })
}

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