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 i

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