Add back/next button to date range input in shiny

Question

I spent quite a while trying to figure out how to add back/next week button around the daterangeinput field in Shiny. I personally think it is a cool and handy feature and it seems that there is no similar question/answer on stackoverflow (correct me if I'm wrong and I will delete this post).

Here is a screenshot so you know what I am talking about:

Here is a list of features I could think of when I design the code.
1. When you hit back/next buttons, both dates will move backward/forward
2. Back/Next should use the gap between the two dates to jump around
3. When the date on the left hits the minimum dates and you hit back, that date won't decrease anymore but the date on the right side will still decrease until it hits the minimum dates as well
4. When both dates equals to each other at the minimum date, when you hit Next, the date on the right side will increase by 7 (a week) by default.
5. Vice versa for the right side.

Answer 1

I put my code on a public gist.

shiny::runGist("https://gist.github.com/haozhu233/9dd15e7ba973de82f124")

server.r

library(shiny)
shinyServer(function(input, output, session) {

  session$onSessionEnded(function() {
    stopApp()
  })

  date.range <- as.Date(c("2015-01-01", "2015-12-31"))
  # ------- Date Range Input + previous/next week buttons---------------
  output$choose.date <- renderUI({
    dateRangeInput("dates", 
                   label = h3(HTML("<i class='glyphicon glyphicon-calendar'></i> Date Range")), 
                   start = "2015-05-24", end="2015-05-30", 
                   min = date.range[1], max = date.range[2])
  }) 

  output$pre.week.btn <- renderUI({
    actionButton("pre.week", 
                 label = HTML("<span class='small'><i class='glyphicon glyphicon-arrow-left'></i> Back</span>"))
  })
  output$next.week.btn <- renderUI({
    actionButton("next.week", 
                 label = HTML("<span class='small'>Next <i class='glyphicon glyphicon-arrow-right'></i></span>"))
  })

  date.gap <- reactive({input$dates[2]-input$dates[1]+1})
  observeEvent(input$pre.week, {
    if(input$dates[1]-date.gap() < date.range[1]){
      if(input$dates[2]-date.gap() < date.range[1]){
        updateDateRangeInput(session, "dates", start = date.range[1], end = date.range[1])
      }else{updateDateRangeInput(session, "dates", start = date.range[1], end = input$dates[2]-date.gap())}
      #if those two dates inputs equal to each other, use 7 as the gap by default
    }else{if(input$dates[1] == input$dates[2]){updateDateRangeInput(session, "dates", start = input$dates[1]-7, end = input$dates[2])
    }else{updateDateRangeInput(session, "dates", start = input$dates[1]-date.gap(), end = input$dates[2]-date.gap())}
    }})
  observeEvent(input$next.week, {
    if(input$dates[2]+date.gap() > date.range[2]){
      if(input$dates[1]+date.gap() > date.range[2]){
        updateDateRangeInput(session, "dates", start = date.range[2], end = date.range[2])
      }else{updateDateRangeInput(session, "dates", start = input$dates[1]+date.gap(), end = date.range[2])}
    }else{if(input$dates[1] == input$dates[2]){updateDateRangeInput(session, "dates", start = input$dates[1], end = input$dates[2]+7)
    }else{updateDateRangeInput(session, "dates", start = input$dates[1]+date.gap(), end = input$dates[2]+date.gap())}
    }})

  output$dates.input <- renderPrint({input$dates})
})
#------- End of Date range input -----------------

ui.r

library(shiny)
shinyUI(
  navbarPage("Demo", 
             position = "static-top",
             fluid = F,

             #================================ Tab 1 =====================================
             tabPanel("Demo",class="active",
                      sidebarLayout(
                        sidebarPanel(uiOutput("choose.date"),
                                     tags$div(class="row",
                                              tags$div(class="col-xs-6 text-center", uiOutput("pre.week.btn")),
                                              tags$div(class="col-xs-6 text-center", uiOutput("next.week.btn")))
                        ),
                        mainPanel = (
                          textOutput("dates.input")
                        )
                      ))))