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

Question

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 the months. Though i have mentioned the

format = 'mm-yyyy' and startview = 'year' in dateInput or dateRangeInput

Whenever the user clicks on the date input field, the user will be displayed the months and then on clicking any month the user is displayed with the dates in the month.

I want the user to be displayed till the months. If the user clicks on the month the dates should not be displayed.

How can this be achieved?

Answer 1

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

Answer 2

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

Answer 3

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

Answer 4

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 :(