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!
