Condition Filter in dplyr based on Shiny input

问题:

I'm creating a reporting tool for an online market. I want to add a checkbox, "Coupon", where only observations that have a positive value in the Coupon field are selected.

So, in ui.R I have:

checkboxInput("checkbox", label = "Coupon", value = TRUE)

This is working fine.

In server.R I have:

  Coupon_Select <- reactive({ 
    if(input$checkbox == TRUE){0}
      else {-1}  
  })

and

Data_Select <- reactive({
    Orders %>%
      filter(Region %in% Region_Select(), Community.Type %in% Type_Select(), 
             Coupon > Coupon_Select()
      )
    })

The idea here is that if the Checkbox is checked, dplyr would only select observations whose 'Coupon' value > 0. If it's not checked, it would select observations whose 'Coupon' value > -1. However, I realize now it doesn't work because Coupons with no value are given a NA - therefore, regardless of the value of the checkbox, I'm only getting observations with coupon values > 0.

So, my question is, how can I make dplyr output only observations with Coupon values that aren't NA when the checkbox is checked, and all observations when it's not checked?

回答1:

Given that you indicated that there are actual multiple variables you need to either filter for NA or not, you could do this using standard evaluation via filter_ and some help from package lazyeval.

library(dplyr)
library(lazyeval)

The algorithm would be something like this:

First, for each of your check boxes that you want to either remove the missing values or keep them, you would make a reactive statement in server.r kind of like in your question, except it would either return NULL or the variable name from the dataset you are using as a string.

Coupon_Select <- reactive({ 
    if(input$checkbox){"Coupon"}
      else {NULL}  
  })

Sale_Select <- reactive({ 
    if(input$checkbox2){"Sale"}
      else {NULL}  
  })

You'll use the output of these reactive functions in your Data_Select reactive function. In this step, you'll concatenate the check box reactive result together into a vector or list and then loop through them with lapply to set up the condition for each variable for use in filter_. This involves using interp from package lazyeval much as in this answer. Note that this works when using the same condition for each variable (removing rows that contain missing values for those particular variables).

The output list of conditions to filter on can be used in the .dots argument of filter_. I added the filter_ as a second filtering step, so the other conditions that you will always have can still easily be done via filter.

dataInput = reactive({
        extrafilt = c(Coupon_Select(), Sale_Select())
        dots = lapply(extrafilt, function(cols) interp(~!is.na(x), 
                                                        .values = list(x = as.name(cols))))
        Orders %>%
            filter(Region %in% Region_Select(), Community.Type %in% Type_Select())  %>%
            filter_(.dots = dots)
    })

I found it particularly useful that this works when all check box reactive functions return NULL and you don't need any additional filtering.

回答2:

If you want to stick with dplyr you can include an if else statement in your filtering statement for Orders like this:

Orders %>% 
filter(Region %in% Region_Select(), Community.Type %in% Type_Select() %>% 
{ if (input$coupon == TRUE) filter(., Coupon > 1) else filter(., Coupon > -1 | is.na(Coupon)) }

The first filter is for the items you want to filter regardless of the Coupon checkbox. Inside the curly brackets is an if statement that will filter as you have specified if the checkbox is marked and if not, it will keep everything if I understand the possible outcomes.

I use this type of setup for creating interactive tables in a shiny app.