R Shiny DateRange Input month year only

Question

Is there a way to Hack or Create a dateRangeInput() selector in Shiny so that it selects only month-year (no day) or that it automatically selects the first day of the selected month without displaying a day choice ? Or should I create another month-date picker (sliders, selectbox...)

dateRangeInput('dateRange',label = "Pédiode d'analyse : ",format = "mm/yyyy",language="fr",
    start = Sys.Date() %m-% months(12), end=Sys.Date(),startview = "year",separator = " - ")

What i want is to delete this step when choosing the date : dateRangeInput

Answer 1

Have a look at this custom function monthStart below which can be used to force the date to the first date of that month and year

Example 1, Display the first day of a given month . This may be useful if you want to use the date object for later use in your app, so it will always point to the first day of a given month and year

#rm(list=ls())
library(shiny)

monthStart <- function(x) {
  x <- as.POSIXlt(x)
  x$mday <- 1
  as.Date(x)
}

ui <- basicPage(dateRangeInput('dateRange',label = "Pédiode d'analyse : ",format = "mm/yyyy",language="fr",start = Sys.Date(), end=Sys.Date(),startview = "year",separator = " - "),
                textOutput("SliderText")
)
server <- shinyServer(function(input, output, session){

  Dates <- reactiveValues()
  observe({
    Dates$SelectedDates <- c(as.character(monthStart(input$dateRange[1])),as.character(monthStart(input$dateRange[2])))
  })
  output$SliderText <- renderText({Dates$SelectedDates})
})
shinyApp(ui = ui, server = server)

Example 2, Display only the month and year

#rm(list=ls())
library(shiny)

monthStart <- function(x) {
  x <- as.POSIXlt(x)
  x$mday <- 1
  as.Date(x)
}

ui <- basicPage(dateRangeInput('dateRange',label = "Pédiode d'analyse : ",format = "mm/yyyy",language="fr",start = Sys.Date(), end=Sys.Date(),startview = "year",separator = " - "),
                textOutput("SliderText")
)
server <- shinyServer(function(input, output, session){

  Dates <- reactiveValues()
  observe({
    Dates$SelectedDates <- c(as.character(format(input$dateRange[1],format = "%m/%Y")),as.character(format(input$dateRange[2],format = "%m/%Y")))
  })
  output$SliderText <- renderText({Dates$SelectedDates})
})
shinyApp(ui = ui, server = server)

Answer 2

I've just used airDatePicker() to do this. You can edit the minimum view of the popup calendar to "month" and select the date format as "yyyy-mm".

airDatepickerInput("input_var_name",
                   label = "Start month",
                   value = "2015-10-01",
                   maxDate = "2016-08-01",
                   minDate = "2015-08-01",
                   view = "months", #editing what the popup calendar shows when it opens
                   minView = "months", #making it not possible to go down to a "days" view and pick the wrong date
                   dateFormat = "yyyy-mm"
                   )

The version I've just been working on looks like this (greyed may is where cursor was hovering when I took the screenshot):

Answer 3

Not sure if still relevant, but i was recently looking for something similar and came to this solution

library(shiny)
library(shinyjs)
library(purrr)
library(tibble)
library(stringr)
library(lubridate)
library(reactable)

dates = seq.Date(from = as_date("2022-01-01"), to = as_date("2023-02-01"), by = "month")
labels = paste(month(c(as_date(dates)), label = T), year(c(as_date(dates))))
df = tibble(date = dates, letters = letters[1:14])

ui = fluidPage(
  
  tags$head(tags$style(HTML(".selected {background: rgba(125, 181, 171, .25);}")), shinyjs::useShinyjs()),
  
  div(style = "margin-top: 50px; display: flex; flex-direction: column; gap: 20px; align-items: center;",
  div(style = "display: flex; gap: 1rem;",    
      pmap(
        .l = list(
          dates = dates, 
          labels = labels, 
          classes = c(rep("", 3), rep("selected", 4), rep("", 7))), .f = ~actionButton(inputId = paste0("btn_", ..1), label = ..2) %>%tagAppendAttributes(class = ..3))),
  reactableOutput(outputId = "table"))
  
)

server = function(input, output, session){
  
  range = reactiveValues(from = "2022-04-01", to = "2022-07-01")
  
    map(paste0("btn_", dates), .f = function(x) {
      
      observeEvent(input[[x]], {
        
        freezeReactiveValue(input, "from")
        freezeReactiveValue(input, "to")
        
        val = str_remove(x, pattern = "btn_")
        
        if(!is_null(range$to)){
          
          range$from = val
          range$to = NULL
          
        }else if(is_null(range$to)){
          
          if(val > range$from){
            
            range$to = val
            
          }else if(val < range$from){
            
            range$to = range$from
            range$from = val
            
          }else if(val == range$from){
            
            range$to = NULL
            
          }
        }
        
        dateseq = if(is_null(range$to)){as_date(range$from)}else{seq.Date(as_date(range$from), as_date(range$to), by = "month")}
        map(.x = paste0("btn_", dates)[!paste0("btn_", dates)%in%paste0("btn_", dateseq)], .f = ~shinyjs::removeClass(id = .x, class = "selected"))
        map(.x = paste0("btn_", dateseq), .f = ~shinyjs::addClass(id = .x, class = "selected"))
        
    })
  })
    
  output$table = renderReactable({
    
    datevalues = if(is_null(range$to)){c(range$from, range$from)}else{c(range$from, range$to)}
    
    reactable(df[df$date>=as_date(datevalues[1])&df$date<=as_date(datevalues[2]),], defaultPageSize = 14)
    
  })  
}
shinyApp(ui, server)