Display only months in dateRangeInput or dateInput for a shiny app [R programming]

前端 未结 4 1631
时光取名叫无心
时光取名叫无心 2020-12-08 05:35

I am using shiny for creating a web app. One of my plots uses only months of a particular year to generate the points in the plot.

I want the users to select only th

相关标签:
4条回答
  • 2020-12-08 06:24

    @MartinJohnHadley: Basically by adding the same three lines @StevenMortimer added to dateInput's code to dateRangeInput. This adds the minViewMode to shinys dateRangeInput.

    1. Find the code at https://github.com/rstudio/shiny/blob/master/R/input-daterange.R
    2. add default argument minviewmode="months"
    3. add data-date-min-view-mode = minviewmode to both divs
    4. Add missing arguments (search in github archive of shiny)
    5. Enjoy your custom dateRange input :-)

    Best regards, sandro

    Code:

    dateRangeMonthsInput <- function(inputId, label, start = NULL, end = NULL,
                                min = NULL, max = NULL, format = "yyyy-mm-dd", startview = "month",
                                minviewmode="months", # added manually
                                weekstart = 0, language = "en", separator = " to ", width = NULL) {
    
       # If start and end are date objects, convert to a string with yyyy-mm-dd format
       # Same for min and max
       if (inherits(start, "Date"))  start <- format(start, "%Y-%m-%d")
       if (inherits(end,   "Date"))  end   <- format(end,   "%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(
         div(id = inputId,
             class = "shiny-date-range-input form-group shiny-input-container",
             style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
    
             controlLabel(inputId, label),
             # input-daterange class is needed for dropdown behavior
             div(class = "input-daterange input-group",
                 tags$input(
                   class = "input-sm form-control",
                   type = "text",
                   `data-date-language` = language,
                   `data-date-weekstart` = weekstart,
                   `data-date-format` = format,
                   `data-date-start-view` = startview,
                   `data-date-min-view-mode` = minviewmode, # added manually
                   `data-min-date` = min,
                   `data-max-date` = max,
                   `data-initial-date` = start
                 ),
                 span(class = "input-group-addon", separator),
                 tags$input(
                   class = "input-sm form-control",
                   type = "text",
                   `data-date-language` = language,
                   `data-date-weekstart` = weekstart,
                   `data-date-format` = format,
                   `data-date-start-view` = startview,
                   `data-date-min-view-mode` = minviewmode, # added manually
                   `data-min-date` = min,
                   `data-max-date` = max,
                   `data-initial-date` = end
                 )
             )
         ),
         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)
     }
    
     # the datePickerDependency is taken from https://github.com/rstudio/shiny/blob/master/R/input-date.R
     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>")
    
    0 讨论(0)
  • 2020-12-08 06:25

    I don't believe dateInput has implemented the bootstrap minViewMode option as a function argument, so I added it in my own copy of the function (see below). I had to add some of the other required functions. This is not great. The best option would probably be to submit a request to RStudio since it seems straightforward to add this minviewmode option.

    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(id = inputId,
                 class = "shiny-date-input form-group shiny-input-container",
                 style = if (!is.null(width)) paste0("width: ", validateCssUnit(width), ";"),
    
                 controlLabel(inputId, label),
                 tags$input(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
                 )
        ),
        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 <- htmlDependency(
      "bootstrap-datepicker", "1.0.2", c(href = "shared/datepicker"),
      script = "js/bootstrap-datepicker.min.js",
      stylesheet = "css/datepicker.css")
    
    0 讨论(0)
  • 2020-12-08 06:29

    To whom wants to use the codes in the previous answer: you need to use the updated datePickerDependecy (which can be taken from https://github.com/rstudio/shiny/blob/master/R/input-date.R).

    Currently it is:

    datePickerDependency <- 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>")
    

    I post this remark as an answer due to not enough reputation :(

    0 讨论(0)
  • 2020-12-08 06:36

    Here is a another method (with less code redundancy and hopefully simpler), contributed by a colleague. Instead of copying the shiny::dateInput function code, it is possible to add the min/max-view-mode part to the Shiny object afterwards. Then the old parameter 'startview' and the new 'minview'/'maxview' can be used as expected:

    dateInput2 <- function(inputId, label, minview = "days", maxview = "decades", ...) {
      d <- shiny::dateInput(inputId, label, ...)
      d$children[[2L]]$attribs[["data-date-min-view-mode"]] <- minview
      d$children[[2L]]$attribs[["data-date-max-view-mode"]] <- maxview
      d
    }
    
    dateRangeInput2 <- function(inputId, label, minview = "days", maxview = "decades", ...) {
      d <- shiny::dateRangeInput(inputId, label, ...)
      d$children[[2L]]$children[[1]]$attribs[["data-date-min-view-mode"]] <- minview
      d$children[[2L]]$children[[3]]$attribs[["data-date-min-view-mode"]] <- minview
      d$children[[2L]]$children[[1]]$attribs[["data-date-max-view-mode"]] <- maxview
      d$children[[2L]]$children[[3]]$attribs[["data-date-max-view-mode"]] <- maxview
      d
    }
    

    And here is a minimal Shiny example:

    library(shiny)
    shinyApp(
      ui = fluidPage(
        dateInput2("test1", "Year", startview = "year", minview = "months", maxview = "decades"),
        dateRangeInput2("test2", "Years", startview = "year", minview = "months", maxview = "decades")
      ),
      server = function(input, output, session) {}
    )
    

    Update:

    To address darKnight's question below, I extended the example and introduced a parameter for setting also the maximum selectable time resolution. For a complete list of possible parameters, please refer to:

    https://bootstrap-datepicker.readthedocs.io/en/latest/options.html

    0 讨论(0)
提交回复
热议问题