Make upper value of R shiny slider range always be higher than lower value [duplicate]

问题

I have a slider that looks like this:

The code for the slider is as follows:

UI:

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

SERVER:

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')
      })

Currently if you move the slider inputs they can be put as the same value like this:

Is there a way so that I can always keep the upper value of the slider a certain amount of ticks above the bottom value of the slider?

回答1:

You can add 31 days to the datetime object you have, however that is crude. Other ways of adding a month you can have a look here: 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)))
    }
  })

Edit: To use the dates later on You can access the dates via the sliderMonth$Month reactive I've created

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)

来源：https://stackoverflow.com/questions/43785070/make-upper-value-of-r-shiny-slider-range-always-be-higher-than-lower-value

标签

Shiny

slider