Multiple filters by lower and upper bound in R Shiny

Vangelis

All of this code is adapted from Shiny - dynamic data filters using insertUI.

I am currently using R Shiny code that is supposed to allow for the creation of multiple filters (as many as the Shiny server will allow).

Each filter includes a selection of the variable to filter by, the upper bound, lower bound, and whether the values will be filtered by taking only the values between the upper and lower bound (i.e., lwr < x < upr), or the opposite (i.e., x < lwr ∪ x > upr). I have compiled the relevant code into code that is specifically relevant to this question.

The source code (for the simplified code) is below:

library(shiny)
library(ggplot2)

# Column names of file.
logColumns <- names(read.csv("file.csv"))

ui <- fluidPage(

   titlePanel("Testing Filters"),

   sidebarLayout(
      sidebarPanel(
        # Data type to display as Y value in graph.
        selectInput("display", label = "Data Type", choice = logColumns),

        # Button to activate addFilter actions.
        fluidRow(
          column(6, actionButton('addFilter', "Add Filter")),
          offset=6
        ),
        tags$hr(),
        # Area to generate new filters.
        tags$div(id='filters'),
        width = 4
      ),

      mainPanel(
         # Displays plot.
         plotOutput("distPlot")
      )
   )
)

server <- function(input, output, session) {
  # File to use.
  usefile <- reactive({
    # Placeholder code, does basic file reading for now.
    # Basic (unedited) file format is time (in milliseconds) in first column
    # followed by other columns with different types of data, e.g., voltage.
    usefile <- read.csv("file.csv", header=TRUE)
    usefile$time <- usefile$time / 1000
    usefile
  })
  # Column names of above file.
  logNames <- reactive({
    names(usefile())
  })

  # Turns aggregFilterObserver into a reactive list.
  makeReactiveBinding("aggregFilterObserver")
  aggregFilterObserver <- list()

  observeEvent(input$addFilter, {

    # Generates unique IDs for each filter.
    add <- input$addFilter
    filterId <- paste0('filter', add)
    colFilter <- paste0('colFilter', add)
    lwrBoundNum <- paste0('lowerBound', add)
    uprBoundNum <- paste0('upperBound', add)
    removeFilter <- paste0('removeFilter', add)
    exclusivity <- paste0('exclusivity', add)

    # Dictates which items are in each generated filter, 
    #   and where each new UI element is generated.
    insertUI(
      selector = '#filters',
      ui = tags$div(id = filterId,
                    actionButton(removeFilter, label = "Remove filter", style = "float: right;"),
                    selectInput(colFilter, label = paste("Filter", add), choices = logNames()),
                    numericInput(lwrBoundNum, label = "Lower Bound", value=0, width = 4000),
                    numericInput(uprBoundNum, label = "Upper Bound", value=0, width = 4000),
                    checkboxInput(exclusivity, label = "Within Boundaries?", value=TRUE)
      )
    )

    # Generates a filter and updates min/max values.
    observeEvent(input[[colFilter]], {

      # Selects a data type to filter by.
      filteredCol <- usefile()[[input[[colFilter]]]]

      # Updates min and max values for lower and upper bounds.
      updateNumericInput(session, lwrBoundNum, min=min(filteredCol), max=max(filteredCol))
      updateNumericInput(session, uprBoundNum, min=min(filteredCol), max=max(filteredCol))

      # Stores data type to filter with in col, and nulls rows.
      aggregFilterObserver[[filterId]]$col <<- input[[colFilter]]
      aggregFilterObserver[[filterId]]$rows <<- NULL
    })

    # Creates boolean vector by which to filter data.
    observeEvent(c(input[[lwrBoundNum]], input[[uprBoundNum]], input[[colFilter]], input[[exclusivity]]), {
      # Takes only data between lower and upper bound (inclusive), or
      if (input[[exclusivity]]){
        rows <- usefile()[[input[[colFilter]]]] >= input[[lwrBoundNum]]
        rows <- "&"(rows, usefile()[[input[[colFilter]]]] <= input[[uprBoundNum]])
      }
      # Takes only data NOT between lower and upper bounds (inclusive).
      else{
        rows <- usefile()[[input[[colFilter]]]] < input[[lwrBoundNum]]
        rows <- "|"(rows, usefile()[[input[[colFilter]]]] > input[[uprBoundNum]])
      }

      aggregFilterObserver[[filterId]]$rows <<- rows
    })

    # Removes filter.
    observeEvent(input[[removeFilter]], {
      # Deletes UI object...
      removeUI(selector = paste0('#', filterId))

      # and nulls the respective vectors in aggregFilterObserver.
      aggregFilterObserver[[filterId]] <<- NULL
    })
  })

  # Filters data based on boolean vectors contained in aggregFitlerObserver
  adjusted <- reactive({
    toAdjust <- rep(TRUE,nrow(usefile()))
    lapply(aggregFilterObserver, function(filter){
      toAdjust <- "&"(toAdjust, filter$rows)
    })
    subset(usefile(), toAdjust)
  })

  # Creates plot based on filtered data and selected data type
  output$distPlot <- renderPlot({
    xData <- adjusted()$time
    yData <- adjusted()[[input$display]]
    curData <- data.frame(xData, yData)
    plot <- ggplot(data=curData, aes(x=xData, y=yData)) + geom_point() + labs(x = "Time (seconds)", y = input$display)
    plot
  })
}

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

My problem is that subsetting via the boolean vectors does not work - i.e., filters simply have no effect whatsoever.

Also, I'm not too sure about the wording and variable names for how the upper and lower bounds should be applied (i.e., the "Within Boundaries?" button and exclusivity variable). If a better (while still concise) wording could be used, I'd appreciate some help with that as well.

Any input is appreciated.

EDIT: After fixing my code with the current answer, I have realized that the code that [the fixed] adjusted() had is not exactly what I wanted, and that I have misunderstood what lapply actually does. I had been trying to compile multiple logical vectors into one, and this was achieved by doing the following:

adjusted <- reactive({
  toAdjust <- rep(TRUE,nrow(usefile()))
  for (filter in aggregFilterObserver){
    toAdjust <- "&"(toAdjust, filter$rows)
  }
  if (length(toAdjust) == 0){
    usefile()
  } else {
    subset(usefile(), toAdjust)
  }
})

Thanks for the help given!

kluu

The problem comes from the fact that you never store the result of the filtering. When you define adjusted, the result of lapply is never stored.

# Filters data based on boolean vectors contained in aggregFitlerObserver
adjusted <- reactive({
  toAdjust <- rep(TRUE,nrow(usefile()))
  tmp <- lapply(aggregFilterObserver, function(filter){
           toAdjust <- "&"(toAdjust, filter$rows)
         })
  if (length(tmp$filter1) == 0) {
    return(usefile())
  } else {
    subset(usefile(), tmp$filter1)
  }
})

The condition length(tmp$filter1) == 0 is here to prevent the filtering of all rows when no filter is present.

Collected from the Internet

Please contact [email protected] to delete if infringement.

edited at
0

Comments

0 comments
Login to comment

Related

Having trouble understanding the upper bound and lower bound in the following R code

Scala upper and lower type bound

Proving an upper and lower bound for an algorithm

Upper and Lower bound on scala type

Day upper Bound and Lower Bound for MongoDB Spring

linear interpolation based on look up tables in R (Finding the Age Lower bound and Upper bound)

How to filters across multiple tabs R Shiny

R Shiny synchronize filters on multiple tabs

Generics - lower/ upper bound wild card behaviour?

Lower and Upper Bound for Java Wildcard Type

Parameter for upper and lower bound in linear programming solvers

Specify a range (upper and lower bound) for a variable in Python

Find an upper and lower bound of following code

How to find a upper and lower bound of code?

how to update a node's lower and upper bound

Determine upper and lower bound of list of values

How to get radius of lower and upper bound of circle?

how to ggplot with upper and lower bound as shaded using facet_wrap in R?

using lower_bound/upper_bound with 2 different types

Questions about std::lower_bound and std::upper_bound

lower_bound and upper_bound in Map of Pairs

rationale for std::lower_bound and std::upper_bound?

Difference between basic binary search for upper bound and lower bound?

Comparator function for upper_bound or lower_bound for vector of vector

upper_bound and lower_bound inconsistent value requirements

Difference between upper_bound and lower_bound in stl

Naming of lower_bound, upper_bound c++

how to find lower bound and upper bound in pandas dataframe?

Multiple filters as input in shiny