How to prevent user from setting the end date before the start date using the Shiny dateRangeInput

问题

I have a shiny app that a user selects multiple date ranges and I would like to prevent the user from setting the end date before the start date using the dateRangeInput in the lapply function. How do I code this in R? Thanks for looking into this.

Here is my code

       library(shiny)

       ui <-fluidPage(
              checkboxInput("add_trend", "Add Trend(s)"),
              conditionalPanel(condition="input.add_trend === true",
                               numericInput("numoftrends",
                                            label="Number of Linear Trends:",
                             min = 1,
                             max = 10,
                             value = 1,
                             step = 1),
                             uiOutput("num_of_trends"),
                             textOutput("see_ranges")
                ),
             actionButton("submit", "Submit")
        )

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

         output$num_of_trends <- renderUI({
            lapply(1:input$numoftrends, function(i) {
                  dateRangeInput(paste0("date_range_input", i), 
                          paste('Trend Date Range Input', i, ':'),                                                      

                          separator = " - ",
                          format = "yyyy-mm",
                          startview = 'year',
                          start = "2001-01-01",
                          end   = "2020-12-31",
                          min = "2001-01-01",
                          max = "2020-12-31"
                         )
                })  
           })

       trend_list <- reactive({
           out <- list()
          for(i in 1:input$numoftrends) {
           out[[i]] <- input[[paste0("date_range_input", i)]]
            }
          out
       })

        output$see_ranges <- renderPrint({
           print(trend_list())
         })
      }

       shinyApp(ui = ui, server = server)

回答1:

Okay, to not complicate it unnecessarily I will show you a possibility for one dateRangeInput().

In a nutshell: Store the start and end date in a reactiveValue() and set some restrictions for their updates. As an example i chose to set the start and end date equally if your restrictions are violated.

  global <- reactiveValues(start = "2001-01-01", end= "2020-12-31")

  observe({
    dates <- input[[paste0("date_range_input", 1)]]
    if(!is.null(dates)){
     if(dates[1] <= global$end){
       global$start <- dates[1]
     }else{
       # date smaller than start value not allowed
       global$start <- global$end
     }

     if(dates[2] >= global$start){
       global$end <- dates[2]
     }else{
       # date greater than end value not allowed
       global$end <- global$start
     }
    }
  })

  output$num_of_trends <- renderUI({
      dateRangeInput(paste0("date_range_input", 1), 
                     paste('Trend Date Range Input', 1, ':'),
                     separator = " - ",
                     format = "yyyy-mm",
                     startview = 'year',
                     start = global$start,
                     end   = global$end,
                     min = "2001-01-01",
                     max = "2020-12-31"
      )
  })

For a full version with multiple dateRangeInput() see below:

library(shiny)

ui <-fluidPage(
  checkboxInput("add_trend", "Add Trend(s)"),
  conditionalPanel(condition="input.add_trend === true",
                   numericInput("numoftrends",
                                label="Number of Linear Trends:",
                                min = 1,
                                max = 10,
                                value = 1,
                                step = 1),
                   uiOutput("num_of_trends"),
                   textOutput("see_ranges")
  ),
  actionButton("submit", "Submit")
)

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

  global <- reactiveValues(start = "2001-01-01", end = "2020-12-31")

  observe({
    global$start <- as.Date(c(global$start, as.Date(rep("2001-01-01", input$numoftrends))))[1:input$numoftrends]
    print(global$start)
    global$end <- as.Date(c(global$end, as.Date(rep("2020-12-31", input$numoftrends))))[1:input$numoftrends]
  })

  observe({
    for(i in 1:input$numoftrends){
      dates <- input[[paste0("date_range_input", i)]]
      if(!is.null(dates)){
        # print(global$end[i])
        if(dates[1] <= global$end[i]){
          global$start[i] <- dates[1]
        }else{
          # date smaller than start value not allowed
          global$start[i] <- global$end[i]
        }
        # print(global$start[i])
        if(dates[2] >= global$start[i]){
          global$end[i] <- dates[2]
        }else{
          # date greater than end value not allowed
          global$end[i] <- global$start[i]
        }
      }
    }
  })

  output$num_of_trends <- renderUI({
    lapply(1:input$numoftrends, function(i) {
      dateRangeInput(paste0("date_range_input", i), 
                     paste('Trend Date Range Input', i, ':'),
                     separator = " - ",
                     format = "yyyy-mm",
                     startview = 'year',
                     start = global$start[i],
                     end   = global$end[i],
                     min = "2001-01-01",
                     max = "2020-12-31"
      )
    })
  })

  trend_list <- reactive({
    out <- list()
    for(i in 1:input$numoftrends) {
      out[[i]] <- input[[paste0("date_range_input", i)]]
    }
    out
  })

  output$see_ranges <- renderPrint({
    print(trend_list())
  })
}

shinyApp(ui = ui, server = server)

回答2:

I have run across this but solved it in a different way. I just assume that the user has selected the date range they want and then use max and min.

start<-min(dates)
end<-max(dates)

Problem solved. Works for user who is confused.

来源：https://stackoverflow.com/questions/43614708/how-to-prevent-user-from-setting-the-end-date-before-the-start-date-using-the-sh