添加回/下一個按鈕日期範圍輸入閃亮

我花了很長一段時間，試圖找出如何添加回落/下週按鈕周圍的日期範圍輸入字段在閃亮。我個人認爲這是一個很酷且方便的功能，似乎在stackoverflow上沒有類似的問題/答案（糾正我，如果我錯了，我會刪除這篇文章）。添加回/下一個按鈕日期範圍輸入閃亮

下面是截圖，所以你知道我在說什麼：

這裏是我能想到的，當我設計的代碼功能列表。
1.當你打回/下一個按鈕，這兩個日期將向後移動/前進
2.返回/下一步應使用兩個日期之間的差距跳來跳去
3.當左邊的日期打最低日期和你回來，這個日期不會再減少，但右側的日期仍然會下降，直到它達到最低日期
4.當兩個日期在最低日期相等時，當你點擊接下來，默認情況下，右側的日期將增加7（一週）。
5.反之亦然。

來源

2015-09-30 Hao

我把我的代碼放在公共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") 
         ) 
        ))))

來源

2015-09-30 17:36:53 Hao

添加回/下一個按鈕日期範圍輸入閃亮

回答

相關問題