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)
与恶龙缠斗过久,自身亦成为恶龙;凝视深渊过久,深渊将回以凝视…