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:
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
Post a Comment