Logo Questions Linux Laravel Mysql Ubuntu Git Menu
 

Dynamic AND OR filter in R Shiny

Tags:

r

shiny

I am struggling to make a set of dynamic data filters on multiple fields with selectable AND/OR join between fields which should look like following:

enter image description here

Here is my example code. I am just not sure how to make the filter joins (AND/OR) work properly.

library(shiny)
library(dplyr)
library(DT)

data("baseball")

Year = unique(baseball$year)
Team = unique(baseball$team)
Stint = unique(baseball$stint)

runApp(list(ui = fluidPage(
  titlePanel("Summary"),

  sidebarLayout(
    sidebarPanel(

      selectInput("year", label = "Year", choices = Year, selected = NULL, multiple = TRUE),
      selectInput("filter_join1", label = "", choices = c("OR","AND")),
      selectInput("team", label = "Team", choices = Team, selected = NULL, multiple = TRUE),
      selectInput("filter_join2", label = "", choices = c("OR","AND")),
      selectInput("stint", label = "Stint", choices = Stint, selected = NULL, multiple = TRUE)
    ),

    mainPanel(
      DT::dataTableOutput("table")
    )
  )
),

server = function(input, output, session) {
  WorkingDataset   <- reactive({ 
    df_temp <- baseball %>%
      filter(
        is.null(input$year)  | year %in% input$year,
        is.null(input$team)  | team %in% input$team,
        is.null(input$stint) | stint %in% input$stint
      )
    }) 

  output$table <- DT::renderDataTable({ WorkingDataset() })

})

)
like image 585
M.Qasim Avatar asked Jul 11 '16 22:07

M.Qasim


1 Answers

Say, we have the iris dataset and we want to do some subsetting on it.

iris$Species

# We can also use `with` for that
with(iris, Species) 

# We are interested in more complicated subsetting though. Want to have all rows
# with 'setosa'
with(iris, Species %in% 'setosa')
iris[with(iris, Species %in% 'setosa'), ]

# Now 'setosa' with some more condition
iris[with(iris, Species %in% 'setosa' & Sepal.Length > 5.3), ]


# That works perfectly. There is, however, an another way doing the exact thing in r.
# We can input the subsetting condition as a character string, then change it to 
# the `expression` and `eval`uate it.

cond_str <- paste0("with(iris, Species %in% 'setosa' & Sepal.Length > 5.3)")
cond_str
# which is the same as
cond_str <- paste0("with(iris, ", "Species %in% ", "'", "setosa", "'", " & ", 
                   "Sepal.Length > ", "5.3", ")")
cond_str

# This second approach will prove very powerful since we will replace "setosa"
# with, say, `input$species` later on.


cond <- parse(text = cond_str)
cond
eval(cond)
iris[eval(cond), ] # √

It will get slightly more complicated because input$species may be a vector and as a result we can get multiple character strings as output. For example:

Spec <- c("setosa", "virginica") # ~ input$species
paste0("with(iris, Species %in% ", Spec, ")")

# We want only one character string! So, we'll have to collapse the vector Spec
paste0("with(iris, Species %in% ", 
       paste0(Spec, collapse = " "), ")")

# This is still not what we wanted. We have to wrap the entries into "c()"
# and add quote marks. So, it's going to be pretty technical:
paste0("with(iris, Species %in% ", 
       "c(", paste0("'", Spec, collapse = "',"), "'))")

# Now, this is what we wanted :) Let's check it 
check <- eval(parse(text = paste0("with(iris, Species %in% ", 
       "c(", paste0("'", Spec, collapse = "',"), "'))")))
iris[check, ] # √

Now, let's move to the shiny app. Since I don't know where I can find the dataset baseball which would match your variables, I'm going to use the diamonds dataset from the package ggplot2 and not going to use dplyr.

I slightly modified your app - changed names of variables and then used the trick, I described above, for subsetting. It should be easy for you to fit my example to your problem.

library(shiny)
library(DT)

# data("diamonds") don't know where I can find this dataset, hence I'll use
                # diamond dataset 

library(ggplot2) # for diamonds dataset


cut <- unique(as.character(diamonds$cut)) # or just levels(diamonds$cut)
color <- unique(as.character(diamonds$color))
clarity <- unique(as.character(diamonds$clarity))

runApp(list(ui = fluidPage(
    titlePanel("Summary"),

    sidebarLayout(
      sidebarPanel(
        # changed names of inputs
        selectInput("cut", label = "Cut", choices = cut, selected = NULL, multiple = T),
        selectInput("filter_join1", label = "", choices = c("OR","AND")),
        selectInput("color", label = "Color", choices = color, selected = NULL, multiple = T),
        selectInput("filter_join2", label = "", choices = c("OR","AND")),
        selectInput("clarity", label = "Clarity", choices = clarity, selected = NULL, multiple = T)
      ),

      mainPanel(
        DT::dataTableOutput("table")
      )
    )
  ),

  server = function(input, output, session) {

    WorkingDataset <- reactive({ 
      req(input$cut, input$color, input$clarity)
      # show table only if all three inputs are available

      # depending on filter_join inputs return "OR" or "AND"
      join1 <- ifelse(test = input$filter_join1 == "OR", yes = "| ", no = "& ")
      join2 <- ifelse(test = input$filter_join2 == "OR", yes = "| ", no = "& ")

      # You could do this differently: just set choices = c("OR" = "|", "AND" = "&"))
      # in the selectInput widget.

      # Similar as in the example above with the iris dataset. 

      cond_str <- paste0(
        "with(diamonds, ", 
        paste0("cut %in% ", "c(", paste0("'", input$cut, collapse = "',"), "')", colapse = " "),
        join1, 
        paste0("color %in% ", "c(", paste0("'", input$color, collapse = "',"), "')", colapse = " "),
        join2,
        paste0("clarity %in% ", "c(", paste0("'", input$clarity, collapse = "',"), "')", colapse = " "),
        ")")

      print(cond_str) # print the result to the console
      cond <- parse(text = cond_str)
      df <- as.data.frame(diamonds)[eval(cond), ]
      df
    }) 

    output$table <- DT::renderDataTable({ WorkingDataset() })

  })
)
like image 135
Michal Majka Avatar answered Oct 11 '22 05:10

Michal Majka