用闪亮的dateInput选择众多非连续日期的方法?

时间:2017-01-18 19:56:11

标签: r date datepicker shiny

public List<FileInfo> myList = new List<FileInfo>(); DirectoryInfo di = new DirectoryInfo(@"\\PDFs"); myList = (di.EnumerateFiles("*.pdf").Where(x => x.LastWriteTime.Date == datetime.Date).ToList()); 似乎仅限于选择一个日期。

dateInput只允许您连续选择一系列日期

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

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

例如,如果可能,我希望能够这样做:

shiny calendar with multiple selected dates

3 个答案:

答案 0 :(得分:1)

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

enter image description here

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)

答案 1 :(得分:1)

在shinyWidgets 包中,您有airDatepicker 使用参数multiple=TRUE 来实现这一点。查看this page了解详情。

答案 2 :(得分:-1)

我重写了dateInput函数。

您还可以查看:enter link

  mydateInput <- function(inputId, label, value = NULL, min = NULL, max = NULL,
                        format = "yyyy-mm-dd", startview = "month", weekstart = 0, language = "en", minviewmode="months",
                        width = NULL) {

  # If value is a date object, convert it to a string with yyyy-mm-dd format
  # Same for min and max
  if (inherits(value, "Date"))  value <- format(value, "%Y-%m-%d")
  if (inherits(min,   "Date"))  min   <- format(min,   "%Y-%m-%d")
  if (inherits(max,   "Date"))  max   <- format(max,   "%Y-%m-%d")

  htmltools::attachDependencies(
    tags$div(
             class = "shiny-date-input form-group shiny-input-container",
             style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),

             controlLabel(inputId, label),
             tags$input(id = inputId, type = "text",
                        # datepicker class necessary for dropdown to display correctly
                        class = "form-control datepicker",
                        `data-date-language` = language,
                        `data-date-weekstart` = weekstart,
                        `data-date-format` = format,
                        `data-date-start-view` = startview,
                        `data-date-min-view-mode` = minviewmode,
                        `data-min-date` = min,
                        `data-max-date` = max,
                        `data-initial-date` = value,
                        `data-date-multidate` = 'true'

             )
    ),
    datePickerDependency
  )
}

`%AND%` <- function(x, y) {
  if (!is.null(x) && !is.na(x))
    if (!is.null(y) && !is.na(y))
      return(y)
  return(NULL)
}

controlLabel <- function(controlName, label) {
  label %AND% tags$label(class = "control-label", `for` = controlName, label)
}

datePickerDependency <- htmltools::htmlDependency(
  "bootstrap-datepicker", "1.6.4", c(href = "shared/datepicker"),
  script = "js/bootstrap-datepicker.min.js",
  stylesheet = "css/bootstrap-datepicker3.min.css",
  # Need to enable noConflict mode. See #1346.
  head = "<script>
  (function() {
  var datepicker = $.fn.datepicker.noConflict();
  $.fn.bsDatepicker = datepicker;
  })();
  </script>")


  [1]: https://stackoverflow.com/questions/31152960/display-only-months-in-daterangeinput-or-dateinput-for-a-shiny-app-r-programmin/32171132
相关问题