r - 在 Shiny 中使用 dateInput 选择多个非连续日期的方法？

Question

dateInput似乎仅限于选择单个日期。
dateRangeInput只允许您在一行中选择一个日期范围。

有没有办法选择不连续的多个日期(即不连续的日期)？

我真正想要的是一个日历，我可以在其中选择(单击)多个日期，从而将所有这些日期选择为单独的输入值。

例如，如果可能的话，我希望能够做到这一点:

Answer 1

也许这会帮助有需要的人。您可以从日期选择器中选择多个日期。日期保存在有序的时间表中。单击所选日期将从列表中删除该日期。列表中的日期可以通过 dates$df$date 访问.观察代码来自另一个 SO 帖子，不幸的是我再也找不到了。如果您发现/知道该帖子，请随时链接该帖子。随机 id 用于标识数据帧和 uiComponents 列表中的项目。您可能会注意到，某天它可能无法正常工作。

library(shiny)

ui <- fluidPage(
  headerPanel("Multiple Dates",  windowTitle = "Dates"),
  fluidRow(
    column(width = 2,
                 dateInput("date", "Date", value = "2019-05-31"),
                 tags$b("Selected"),
                 uiOutput("container")
    ),
    column(width = 10,
              verbatimTextOutput("text")
    )
  )
)


server <- function(input, output, session) {

  container <- reactiveValues(uiComponents = list())

  # empty data frame
  dates <- reactiveValues(df = data.frame(matrix(ncol=2,nrow=0, dimnames=list(NULL, c("id", "date")))))

  ###### Monitor changes in date-picker and add new dates to uiComponents
  observeEvent(input$date, {
    isolate({
      rnd <- as.integer(runif(1,1e5,1e6-1))
      dates$df <- rbind(dates$df, data.frame(id = rnd, date = input$date))
      dates$df <- dates$df[order(dates$df$date), ] # sort by date
      container$uiComponents <- NULL  # delete list and re-write it from df
      for (i in 1:NROW(dates$df)) {
        container$uiComponents <- append(
          container$uiComponents,
          list(
            list(
              "link" = actionLink(paste0("link", dates$df$id[i]), label = as.character(dates$df$date[i])),
              "br" = br()
            )
          )
        )
      }
    })
  }, ignoreInit = TRUE)

  ###### Monitor and locate click events from list
  observe({
    if(length(container$uiComponents) == 0) return()
    # links <- lapply(container$uiComponents, `[[`, "link")
    readLinkID <- sapply(container$uiComponents, function(x) {
      x$link$attribs$id
    })
    readLinkVals <- sapply(readLinkID, function(x) input[[x]])
    if(any(sapply(readLinkVals, is.null))) return()
    if(all(readLinkVals == 0)) return()
    isolate({
      container$uiComponents[[which(readLinkVals > 0)]] <- NULL
      dates$df <- dates$df[-which(readLinkVals > 0), ]
    })
  })

  output$container <- renderUI({
    container$uiComponents
  })

  output$text <- renderPrint({
    print(dates$df)
    str(container$uiComponents)
  })
}

shinyApp(ui = ui, server = server)