No "datesdisabled" in updateDateInput in R Shiny? - r

Question

I built an app in R Shiny which uses time series data that excludes many dates. Within the app a user can select a new dataset, so the dates available will change. I'm using updateDateInput to update the dateInput selector. However, updateDateInput does not seem to allow the datesdisabled function?
Here is a reprex:
library(shiny)
# Sample 3 dates and disable the rest
my_dates <- sample(seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day"), 3)
date_choices <- seq.Date(from = min(my_dates), to = max(my_dates), by = 1)
dates_disabled <- date_choices[!(date_choices %in% my_dates)]
ui <- fluidPage(
dateInput("date", "Select Date",
min = min(date_choices),
max = max(date_choices),
value = max(date_choices),
datesdisabled = dates_disabled),
actionButton("click", "Click Me")
)
server <- function(input, output, session) {
observeEvent(input$click, {
my_dates <- sample(seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day"), 3)
date_choices <- seq.Date(from = min(my_dates), to = max(my_dates), by = 1)
dates_disabled <- date_choices[!(date_choices %in% my_dates)]
updateDateInput(
session,
"date",
min = min(date_choices),
max = max(date_choices),
value = max(date_choices),
datesdisabled = dates_disabled)
})
}
shinyApp(ui, server)
When the button is clicked and the updateDateInput runs, I get this error:
Warning: Error in updateDateInput: unused argument (datesdisabled =
dates_disabled)
I guess there is the option of changing the date to a character and using selectInput? But then I don't get the nice calendar!

Answer 1

You are right, the datesdisabled argument is not available in the update function. You can change the disabled dates by moving the UI declaration into the server and feed it to the client with renderUI().
The sample does not declare the date input in the UI but a uiOutput("date"). The server can dynamically create the dateInput using the datesdisabled argument. This way you can change the disabled dates.
The example will pick only 3 enabled dates after every button click.
# Reprex: The actual implementation of this uses data from a file:
# 1. Reads data file before ui and server are established
# 2. Does a bunch of calculations
# 3. Identifies dates that exist in data file
# 4. The data file is getting updated in the background from another application.
# 5. Allows user to click the button to update the data file. Reprex shows code
# that is used to update the date selector based on new data read. Dates are
# random in reprex, but would come from data file in actual code.
# Sample 3 dates and disable the rest - actual code reads data file here
# and parses out dates that exist in records
my_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day")
date_choices <- sample(my_dates, 31-3)
ui <- fluidPage(
uiOutput("date"), textOutput("disabled"),
actionButton("click", "Click Me")
)
server <- function(input, output, session) {
dates_disabled <- reactiveVal(NULL)
# Init 'dates_disabled()' once before Shiny flushes the reactive system with callback,
# using date_choices that exist in original data set
onFlush(fun = function () {dates_disabled(date_choices)}, once = TRUE)
# dateInput widget
output$date <- renderUI({
maxDate <- as.Date(max(setdiff(my_dates, dates_disabled())),
origin = "1970-01-01")
dateInput(input = "date",
label = "Select Date",
min = min(my_dates),
max = max(my_dates),
value = maxDate,
datesdisabled = dates_disabled())
})
# This output makes it easier to test if it works by showing the enabled dates
output$disabled <- renderPrint({
req(dates_disabled()) # only run this when 'dates_disabled' is initialized properly
Enabled <- as.Date(setdiff(seq(as.Date('2021-01-01'), as.Date('2021-01-31'), by = "day"),
dates_disabled()),
origin = '1970-01-01')
paste("Enabled:", paste(Enabled[order(Enabled)], collapse = ", "))
})
# Set new datesdisabled on button click
# Actual code would read updated data file and parse new dates
observeEvent(input$click, {
SelectedDates <- sample(my_dates, 31-3)
dates_disabled( SelectedDates )
})
}
shinyApp(ui, server)