r - Add back/next button to date range input in shiny -


i spent quite while trying figure out how add back/next week button around daterangeinput field in shiny. think cool , handy feature , seems there no similar question/answer on stackoverflow (correct me if i'm wrong , delete post).

here screenshot know talking about: enter image description here

here list of features think of when design code.
1. when hit back/next buttons, both dates move backward/forward
2. back/next should use gap between 2 dates jump around
3. when date on left hits minimum dates , hit back, date won't decrease anymore date on right side still decrease until hits minimum dates well
4. when both dates equals each other @ minimum date, when hit next, date on right side increase 7 (a week) default.
5. vice versa right side.

i put code on 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 2 dates inputs equal each other, use 7 gap 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")                         )                       )))) 

Comments

Popular posts from this blog

1111. appearing after print sequence - php -

java - WARN : org.springframework.web.servlet.PageNotFound - No mapping found for HTTP request with URI [/board/] in DispatcherServlet with name 'appServlet' -

Ruby on Rails, ActiveRecord, Postgres, UTF-8 and ASCII-8BIT encodings -