使R闪亮滑块范围的上限值始终高于下限值[重复]答案

【问题标题】：Make upper value of R shiny slider range always be higher than lower value [duplicate]使R闪亮滑块范围的上限值始终高于下限值[重复]
【发布时间】：2017-10-02 18:17:45
【问题描述】：

我有一个如下所示的滑块：

滑块的代码如下：

用户界面：

fluidRow(column(12,
                    uiOutput("slider")))

服务器：

mindate <- "2011-04-01"
maxdate <- "2017-03-31"

    output$slider <- renderUI({
        sliderInput("timeperiod", "Time Period:",
                    min=as.Date(mindate, origin='1970-01-01'),
                    max=as.Date(maxdate, origin='1970-01-01'),
                    value=c(as.Date(mindate, origin='1970-01-01'),
                            as.Date(maxdate, origin='1970-01-01')),
                    timeFormat='%b-%y', dragRange = TRUE, width='700px')
      })

目前，如果您移动滑块输入，它们可以设置为相同的值，如下所示：

有没有办法让我始终保持滑块的上限值比滑块的下限值高出一定的刻度？

【问题讨论】：

我希望最小值和最大值保持不变。我希望上限值的下限大于下限值并且永远不相等。另外，默认情况下，结束日期不能早于开始日期，我担心显示的数据太少，也不担心它会因为范围翻转而中断。

标签： r shiny slider

【解决方案1】：

您可以将 31 天添加到您拥有的日期时间对象，但这很粗糙。其他添加月份的方法可以看这里：Add a month to a Date

  observeEvent(input$timeperiod,{
    if(input$timeperiod[1] == input$timeperiod[2]){
      updateSliderInput(session, "timeperiod", value=c(input$timeperiod[1],(input$timeperiod[1]+31)))
    }
  })

编辑：稍后使用日期 您可以通过我创建的 sliderMonth$Month 反应式访问日期

rm(list=ls())
library(shiny)

monthStart <- function(x) {
  x <- as.POSIXlt(x)
  x$mday <- 1
  as.Date(x)
}

mindate <- "2011-04-01"
maxdate <- "2017-03-31"

ui <- fluidPage(
  mainPanel(uiOutput("slider"),textOutput("SliderText"))
)

server <- function(input, output, session) {

  observeEvent(input$timeperiod,{
    if(input$timeperiod[1] == input$timeperiod[2]){
      updateSliderInput(session, "timeperiod", value=c(input$timeperiod[1],(input$timeperiod[1]+31)))
    }
  })

  output$slider <- renderUI({
    sliderInput("timeperiod", "Time Period:",
                min=as.Date(mindate, origin='1970-01-01'),
                max=as.Date(maxdate, origin='1970-01-01'),
                value=c(as.Date(mindate, origin='1970-01-01'),as.Date(maxdate, origin='1970-01-01')),
                timeFormat='%b-%y', dragRange = TRUE, width='700px')
  })

  sliderMonth <- reactiveValues()
  observeEvent(input$timeperiod,{
    full.date <- as.POSIXct(input$timeperiod, tz="GMT")
    sliderMonth$Month <- as.character(monthStart(full.date))
  })
  output$SliderText <- renderText({sliderMonth$Month})
}
shinyApp(ui, server)

【讨论】：

这正是我一直在寻找的想法。我可能会尝试使用 lubridate 来处理月份添加。