Настройте вывод дат в Shiny

Почему бы вам не использовать dateInput() тип ввода вместо selectInput()?

Если вы хотите, чтобы для выбора были доступны только определенные даты, вы можете отключить другие даты в пределах dateInput(). Однако это становится немного более сложным, так как вы не можете обновить аргумент datesdisabled с помощью функции updateDateInput(), которая включена. Я предполагаю, что вам нужен формат day-month-year в американском стиле, но если нет, вы можете редактировать формат.

Например:

library(shiny)
library(shinythemes)

function.cl<-function(df,date, d1,d2){
    df <- structure(
        list(date = c("2021-01-01","2021-01-02","2021-01-03","2021-01-04","2021-01-05"),
             d1 = c(0,1,4,5,6), d2 = c(2,4,5,6,7)),class = "data.frame", row.names = c(NA, -5L))
}    
ui <- fluidPage(
    
    ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                            br(),
                            
                            tabPanel("",
                                     sidebarLayout(
                                         sidebarPanel(
                                             
                                             uiOutput("date"),
                                             selectInput("d1", label = h4("D1"),""),
                                             selectInput("d2", label = h4("D2"),""),
                                             br(),
                                             actionButton("reset", "Reset"),
                                         ),
                                         
                                         mainPanel(
                                         ))
                            )))


server <- function(input, output,session) {
    data <- reactive(function.cl())
      
    output$date <- renderUI({
        all_dates <- seq(as.Date('2021-01-01'), as.Date('2021-01-15'), by = "day")
        disabled <- as.Date(setdiff(all_dates, as.Date(data()$date)), origin = "1970-01-01")
        
        dateInput(input = "date", 
                  label = "Select Date",
                  min = min(data()$date),
                  max = max(data()$date),
                  value = max(data()$date),
                  format = "dd-mm-yyyy",
                  datesdisabled = disabled)
    })

    observe({
        updateSelectInput(session, "d1", label = "D1", unique(data()$d1))
        updateSelectInput(session, "d2", label = "D2", unique(data()$d2))
    })
}

shinyApp(ui = ui, server = server)

Редактировать: Кроме того, вы только что определили даты выше как строки, поэтому вы можете просто переформатировать строки.

Т.е. функцию, в которой вы определяете свои данные, можно просто изменить:

function.cl<-function(df,date, d1,d2){
    
    df <- structure(
        list(date = c("01-01-2021","01-02-2021","01-03-2021","01-04-2021","01-05-2021"),
             d1 = c(0,1,4,5,6), d2 = c(2,4,5,6,7)),class = "data.frame", row.names = c(NA, -5L))
}

Если вы действительно хотите использовать функцию selectInput(), и, вам действительно нужны даты как типы Date, а не символы, вы также можете просто форматировать между строками и датами.

Например:

library(shiny)
library(shinythemes)

function.cl<-function(df,date, d1,d2){
    
    df <- structure(
        list(date = as.Date(c("01-01-2021","01-02-2021","01-03-2021","01-03-2021","01-05-2021"), format = "%m-%d-%Y"),
             d1 = c(0,1,4,5,6), d2 = c(2,4,5,6,7)),class = "data.frame", row.names = c(NA, -5L))
}    
ui <- fluidPage(
    
    ui <- shiny::navbarPage(theme = shinytheme("flatly"), collapsible = TRUE,
                            br(),
                            
                            tabPanel("",
                                     sidebarLayout(
                                         sidebarPanel(
                                             
                                             selectInput("date", label = h4("Date"),""),
                                             selectInput("d1", label = h4("D1"),""),
                                             selectInput("d2", label = h4("D2"),""),
                                             br(),
                                             actionButton("reset", "Reset"),
                                         ),
                                         
                                         mainPanel(
                                         ))
                            )))


server <- function(input, output,session) {
    data <- reactive(function.cl())
    
    observe({
        updateSelectInput(session, "date",labe ="Date", unique(format(data()$date, format = "%m-%d-%Y")))
        updateSelectInput(session, "d1", label = "D1", unique(data()$d1))
        updateSelectInput(session, "d2", label = "D2", unique(data()$d2))
    })    
}

shinyApp(ui = ui, server = server)