I am building a Shiny App where users can filter out certain projects. I want the project names to appear in the dropdown only if they appear within a certain date range.
I've been able to populate the selectize menu and have been able to make it so users can select all or remove all projects (from the answer to a question I asked previously). However, now that I'm trying to make these names reactive to the date, the observeEvent code from my previous question crashes. I tried to wrap it in a reactive expression, but then nothing happens.
How do I make my projects filterable by date while still keeping the select all and remove all functionality?
library(shiny)
library(plotly)
library(shinyjs)
library(shinydashboard)
library(shinyWidgets)
library(dplyr)
library(htmltools)
library(lubridate)
ui = fluidPage(
tabsetPanel(
tabPanel("View 1", fluid = TRUE,
sidebarLayout(
sidebarPanel(
h4("Select Your Desired Filters"),
div(id = "inputs",
dateRangeInput(
inputId = "date_filter",
label = "Filter by Month and Year",
start = today(),
end = (today() + 90),
min = "2021-04",
max = NULL,
format = "yyyy-mm",
startview = "month",
weekstart = 0,
language = "en",
separator = " to ",
width = NULL,
autoclose = TRUE
),
br()),
h5("Include/Exclude Specific Projects"),
selectizeInput(inputId = "filter_by_project",
label = "Filter by Project",
choices = sort(unique(test$project)),
multiple = TRUE,
selected = sort(unique(test$project))),
actionButton(inputId = "remove_all",
label = "Unselect All Projects", style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B"),
actionButton(inputId = "add_all",
label = "Select All Projects", style = "color: #FFFFFF; background-color: #CA001B; border_color: #CA001B")
),
mainPanel(
)
)
)
)
)
server = function(input, output, session) {
#Here's the dataset
test <- tibble(project = c("Justin", "Corey","Sibley"),
date = ymd(c("2021-04-20", "2021-04-01", "2021-05-05")),
april_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7))
#I want users to be able to filter the list of projects by date, which should update the selectize options
test <- reactive({
test %>%
dplyr::filter(date >= input$date_filter[1],
date <= input$date_filter[2])
})
observeEvent(input$remove_all, {reactive({
updateSelectizeInput(session,"filter_by_project",choices=sort(unique(test()$project)),
selected=NULL, options = list(placeholder="Please Select at Least One Project")
)
})
})
observeEvent(input$add_all, {reactive({
updateSelectizeInput(session,"filter_by_project",choices=sort(unique(test()$project)), selected=sort(unique(test()$project)) )
})
})
}
shinyApp(ui = ui, server = server)
You have two major problems. First is using the same name for your input data.frame and for your reactive element. You've called them both test which causes confusion as to whether you are trying to use the data.frame or the reactive object. You should use different names. The second problem is you do not need to use reactive() for your observeEvents() calls. You just need to put the code you want to run in a block.
Fixing these problems, your server functon should look more like this
server = function(input, output, session) {
#Here's the dataset
testdata <- tibble(project = c("Justin", "Corey","Sibley"),
date = ymd(c("2021-04-20", "2021-04-01", "2021-05-05")),
april_2021 = c(10, 100, 101),
may_2021 = c(1, 4, 7))
#I want users to be able to filter the list of projects by date, which should update the selectize options
test <- reactive({
testdata %>%
dplyr::filter(date >= input$date_filter[1],
date <= input$date_filter[2])
})
observeEvent(input$remove_all, {
updateSelectizeInput(session,"filter_by_project", choices=sort(unique(test()$project)),
selected=NULL, options = list(placeholder="Please Select at Least One Project")
)
})
observeEvent(input$add_all, {
updateSelectizeInput(session,"filter_by_project", choices=sort(unique(test()$project)), selected=sort(unique(test()$project)) )
})
}