How to prevent user from setting the end date before the start date using the Shiny dateRangeInput
Okay, to not complicate it unnecessarily I will show you a possibility for one dateRangeInput().
In a nutshell: Store the start and end date in a reactiveValue() and set some restrictions for their updates.
As an example i chose to set the start and end date equally if your restrictions are violated.
global <- reactiveValues(start = "2001-01-01", end= "2020-12-31")
observe({
dates <- input[[paste0("date_range_input", 1)]]
if(!is.null(dates)){
if(dates[1] <= global$end){
global$start <- dates[1]
}else{
# date smaller than start value not allowed
global$start <- global$end
}
if(dates[2] >= global$start){
global$end <- dates[2]
}else{
# date greater than end value not allowed
global$end <- global$start
}
}
})
output$num_of_trends <- renderUI({
dateRangeInput(paste0("date_range_input", 1),
paste('Trend Date Range Input', 1, ':'),
separator = " - ",
format = "yyyy-mm",
startview = 'year',
start = global$start,
end = global$end,
min = "2001-01-01",
max = "2020-12-31"
)
})
For a full version with multiple dateRangeInput() see below:
library(shiny)
ui <-fluidPage(
checkboxInput("add_trend", "Add Trend(s)"),
conditionalPanel(condition="input.add_trend === true",
numericInput("numoftrends",
label="Number of Linear Trends:",
min = 1,
max = 10,
value = 1,
step = 1),
uiOutput("num_of_trends"),
textOutput("see_ranges")
),
actionButton("submit", "Submit")
)
server <- function(input, output, session) {
global <- reactiveValues(start = "2001-01-01", end = "2020-12-31")
observe({
global$start <- as.Date(c(global$start, as.Date(rep("2001-01-01", input$numoftrends))))[1:input$numoftrends]
print(global$start)
global$end <- as.Date(c(global$end, as.Date(rep("2020-12-31", input$numoftrends))))[1:input$numoftrends]
})
observe({
for(i in 1:input$numoftrends){
dates <- input[[paste0("date_range_input", i)]]
if(!is.null(dates)){
# print(global$end[i])
if(dates[1] <= global$end[i]){
global$start[i] <- dates[1]
}else{
# date smaller than start value not allowed
global$start[i] <- global$end[i]
}
# print(global$start[i])
if(dates[2] >= global$start[i]){
global$end[i] <- dates[2]
}else{
# date greater than end value not allowed
global$end[i] <- global$start[i]
}
}
}
})
output$num_of_trends <- renderUI({
lapply(1:input$numoftrends, function(i) {
dateRangeInput(paste0("date_range_input", i),
paste('Trend Date Range Input', i, ':'),
separator = " - ",
format = "yyyy-mm",
startview = 'year',
start = global$start[i],
end = global$end[i],
min = "2001-01-01",
max = "2020-12-31"
)
})
})
trend_list <- reactive({
out <- list()
for(i in 1:input$numoftrends) {
out[[i]] <- input[[paste0("date_range_input", i)]]
}
out
})
output$see_ranges <- renderPrint({
print(trend_list())
})
}
shinyApp(ui = ui, server = server)
Prevent End Date Before Start Date and Vice Versa in dateRangeInput
Here's another approach using reactiveValues. You can store your start and end dates in reactiveValues and then use observe to compare with the date range input. The input is also dynamically created in server instead of ui and references the reactiveValues.
library(shiny)
ui <-fluidPage(
uiOutput("date_range")
)
server <- function(input, output, session) {
rv <- reactiveValues(start = as.Date("2021-01-01"), end = as.Date(Sys.Date()))
observe({
req(input$mu_date_range)
dates <- as.Date(input$mu_date_range)
if(dates[1] < rv$end) {
rv$start <- dates[1]
} else {
rv$start <- rv$end
}
if(dates[2] > rv$start) {
rv$end <- dates[2]
} else {
rv$end <- rv$start
}
})
output$date_range <- renderUI({
dateRangeInput(
inputId = "mu_date_range",
label = "Select Registration Date Range",
start = rv$start,
end = rv$end,
min = "2020-01-01",
max = "2021-12-31",
format = 'M yyyy',
startview = 'year',
separator = '-')
})
}
shinyApp(ui = ui, server = server)
Is it possible to make an observeEvent for the start date and end date separately for dateRangeInput?
Thanks to everyone for chiming in with their input. I realize now that I could have put a better, reproducible example up to help you guys get a better idea of my problem, so sorry about that - I will keep this in mind for future posts (shoutout to @MrFlick for the great link to a post about making one!)
I ended up taking @r2evans comment into account and was able to come up with a solution based off of it! I'm fairly new to Stackoverflow so not sure if I can mark a comment as the answer, but thank you so much @r2evans!
Below was the solution that I used in my server function to help me get the functionality I wanted:
curr_date <- shiny::reactiveValues(start=format(Sys.Date(),"%Y-%m-%d"), end=format(Sys.Date(), "%Y-%m-%d"))
shiny::observeEvent(input$reports_date_range, {
dates <- input$reports_date_range
# if start date changed
if (dates[1] != curr_date$start) {
# if start date is after end date, have end date follow and update curr_date
if(dates[1] > curr_date$end) {
updateDateRangeInput(session, "reports_date_range", start = dates[1], end = dates[1])
curr_date$start <- dates[1]
curr_date$end <- dates[1]
} else { # if start date is equal to or before end date, update curr_date$start
curr_date$start <- dates[1]
}
} else if (dates[2] != curr_date$end) { # if end date changed
# if end date is before start date, have start date follow end date
if(dates[2] < curr_date$start) {
updateDateRangeInput(session, "reports_date_range", start = dates[2], end = dates[2])
curr_date$start <- dates[2]
curr_date$end <- dates[2]
} else { # if end date is equal to or after the start date, update curr_date$end
curr_date$end <- dates[2]
}
}
})
Basically, the reactive values in curr_date hold the current date the inputs are defaulted to at the beginning, and are updated to what the inputs become every time they are changed.
In the server logic, I check if there is a mismatch between the date inputted by the user, and the historic value I have for the input in curr_date to figure out which of the two dates (start or end) were changed by the user. Then, it's a simple matter of applying the correct code based on what the user did!
Thank you once again everyone and let me know if there is anything you guys can spot to make this solution better, I will update if there are any findings!
Restrict SliderInput in R Shiny date range to weekdays
I was facing the same problem and this worked for me. The solution relies on shinyWidgets::sliderTextInput(). For this to work you must define your choices of dates and default values up front (I'd recommend somewhere before the UI):
#packages
library(shinyWidgets)
library(lubridate)
#date choices
choices <- seq.Date(date("2021-01-01", today() - 1, by = 1)
choices <- choices[!wday(choices) %in% c(1, 7)] #removes weekends
default <- seq.Date(today() - 182, today() - 180, by = 1)
default <- default[!wday(default) %in% c(1, 7)]
default <- max(default) #most recent weekday
Then you want to stick this within the appropriate place in your UI in place of sliderInput():
sliderTextInput("trajectory", "Date Range:", choices = choices,
selected = c(default, max(choices)))
You'll retain many of the benefits of sliderInput doing it this way, but you may have to work with the grid option to get tick marks and labels to your liking.
Related Topics
Extracting Output from Principal Function in Psych Package as a Data Frame
How to Plot a Stacked Bar with Ggplot
Find and Replace Missing Values with Row Mean
Parsimonious Way to Add North Arrow and Scale Bar to Ggmap
Fastest Way to Get Min from Every Column in a Matrix
R Shiny: How to Write Loop for Observeevent
Dplyr: Grouping and Summarizing/Mutating Data with Rolling Time Windows
Continuous Color Bar with Separators Instead of Ticks
Equation Numbering in Rmarkdown - for Export to Word
Nls Troubles: Missing Value or an Infinity Produced When Evaluating the Model
Object Not Found Error with Ggplot2
Apply a Summarise Condition to a Range of Columns When Using Dplyr Group_By
How to Merge Multiple Data.Frames and Sum and Average Columns at the Same Time in R
Rmarkdown Removes Citation Hyperlink
R - Data Frame - Convert to Sparse Matrix