在闪亮的

Question

我花了很长时间试图弄清楚如何在Shiny中的daterangeinput字段周围添加返回/下周按钮。我个人认为它是一个很酷且方便的功能，似乎在stackoverflow上没有类似的问题/答案（纠正我，如果我错了，我会删除这篇文章）。

这是一个截图，让您知道我在说什么：

以下是我设计代码时可以想到的功能列表 1.当您按下后退/下一个按钮时，两个日期将向后/向前移动 2.后退/下一步应该使用两个日期之间的间隙来跳转 3.当左边的日期达到最小日期并且您回击时，该日期将不再减少，但右侧的日期仍将减少，直到它达到最小日期为止 4.当两个日期在最短日期相等时，当您点击下一步时，默认情况下右侧的日期将增加7（一周）。 5.反之亦然。

Answer 1

我将代码放在公开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")
                        )
                      ))))