Options for subsetting data in plots in Shiny

Question

I am creating a interactive plot in Shiny where the user will upload a dataset with x and y coordinates (so one column for x, and one column for y) and then Shiny will plot a scatterplot. The dataset the user uploads will have additional columns that will provide information for subsetting on. For example, this could be a dataset the user uploads (called dat):

n = 100
x = runif(n,0,100)
y = runif(n,0,100)

var1 = sample(1:100,n,replace=TRUE)
var2 = as.factor(sample(1:3,n,replace=TRUE))
var3 = sample(c("A","B"),n,replace=TRUE)

dat = data.frame(x,y,var1,var2,var3)

Now, I would like to have functionality such that if the user wants to only plot, say, x-y pairs such that var1 >= 54 and var3 == "B" or var2 == "3", or some other combination of subsetting rules, that they can specify the variable that they want to subset on, and then the criteria for subsetting.

What I was able to come up with was to allow the user to write a string of the subsetting criteria, for example just have them manually type var1 >=54 & var3=="B", however, this tool is going to be used by people without programming backgrounds and so a solution that uses less programming knowledge the better.

I could also envision something that has one field, you populate it with the subsetting variable, another box for say >, >=, =, <=, <, !=, and then the value, and then after you fill that out another field appears if you want to further subset but I wasn't able to figure out if this is a realistic task in Shiny. Another difficulty though with this approach is how to allow the user to specify AND and OR statements.

Any help/comments/suggestions are greatly appreciated!

Answer 1

My approach to this problem was that the number of filtering conditions should be maximized because of space issues. You can set the maximum number of filters in the names variable. (in the example it is set to 4)

Basically every filter is the same: they consist of a variable, a relational operator, a value and optionally a logical operator to set more filters. For these filters I used a module called filterModuleUI, to generate the filters with an lapply. The last filter doesn't need a logical operator. It is set with the last argument in the module function.

In the server side there is an observeEvent set for every filter to observe the logical operators. If these are set to "-" then further filters are hidden and are also set to "-". i.e.: If you have 4 active filters and you set the first filter's logical operator to "-", then it will hide the second, third and fourth filter.

When clicking the apply button, the conditions are pasted into a list of strings separated by logical operators. i.e: if there are 3 conditions:

... the string used for filtering is:"x>6&x<20&var1>2".

This is evaluated using the eval and parse functions.

Notes:

• There is no exception handling implemented.
• This code could be further improved. Feel free to suggest an edit.

Code below:

library(shiny)
library(shinyjs)

# Set the maximum number of filters e.g: names <- paste0("in", 1:5) for a maximum of 5 filters. 
names <- paste0("in", 1:4)
inputs <- c("var", "oper", "val", "log")

# Create a UI module to reuse
filterModuleUI <- function(id, last = F){
  ns <- NS(id)
  tagList(
    div(class = id,
      fluidRow(
        column(2,
          selectInput(ns("var"),
            "",
            choices = colnames(dat)
          )
        ),
        column(2,
          selectInput(ns("oper"),
            "",
            choices = c(">", ">=", "==", "<=", "<", "!=")
          )
        ),
        column(2,
          textInput(ns("val"),
            ""
          )
        ),
        if(last == F){
          column(2,
            selectInput(ns("log"),
              "",
              choices = c(
                "-" = "-",
                "AND" = "&",
                "OR" = "|"
                ),
              selected = "-"
            )
          )
        }
      )
    )
  )
}

# Load demo data
n = 100
x = runif(n,0,100)
y = runif(n,0,100)

var1 = sample(1:100,n,replace=TRUE)
var2 = as.factor(sample(1:3,n,replace=TRUE))
var3 = sample(c("A","B"),n,replace=TRUE)

dat = data.frame(x,y,var1,var2,var3)


ui <- fluidPage(
  useShinyjs(),
  h3("Filter demo"),
  lapply(names, function(x){
    if(x == names[length(names)]) filterModuleUI(x, last=T)
    else filterModuleUI(x)
  }),

  actionButton("apply", "Apply filter"),
  plotOutput("plot")
)

server <- function(input, output, session){
  # Set observeEvent to hide further filterModule-s if the logical operator is set to "-"
  lapply(names, function(x){
    no_item <- which(names == x)
    input_log <- paste(x, "log", sep = "-")
    if(no_item != length(names)){
      observeEvent(input[[input_log]],{
        next_items <- names[(no_item + 1) : length(names)]
        if(input[[input_log]] == "-"){
          lapply(next_items, function(x){
            updateSelectInput(session, paste(x, "log", sep = "-"), selected = "-")
          })
          lapply(paste(next_items[1], inputs, sep = "-"), hide)
        }
        else lapply(paste(next_items[1], inputs, sep = "-"), show)
      })
    }
  })

  # Initialize data$a with a predefined data.frame (dat)
  data <- reactiveValues(a = dat)

  # Filter based on the selectInput-s
  observeEvent(input$apply,{
    obj <- lapply(names, function(x){
      lapply(inputs, function(y){
        paste(x, y, sep="-")
      })
    })
    # Construct filtering conditions by pasting variable, operator and value together (e.g.: x > 20)  
    condition <- lapply(obj, function(x){
      paste0(input[[x[[1]]]], input[[x[[2]]]], input[[x[[3]]]])
    })
    # Compute how many AND/OR logical operators are used
    used_cond <- sum(sapply(paste(names[-length(names)], "log", sep="-"), function(x){
      input[[x]] != "-"
    }))
    # Paste the conditions together with logical operators
    filter <- vector()
    for(i in 1:(used_cond + 1)){
      nm <- ifelse(i==1, "", input[[paste(names[i-1], "log", sep="-")]])
      filter <- paste(filter, condition[[i]], sep = nm)
    }
    # Check filter in console
    print(filter)
    # Filtering
    data$a <- dat[eval(parse(text=filter)), ]
  })
  output$plot <- renderPlot({
    dat <- data$a
    plot(dat$x, dat$y)
  })
}

shinyApp(ui, server)