Prevent End Date Before Start Date and Vice Versa in dateRangeInput-CodePudding

I have a dateRangeInput in which I want to prevent the user from entering a start date that exceeds the end date and an end date that precedes a start date.

I have my dateRangeInput in the UI. I then take the inputs into an observe in the server to validate and make the end date and start date equal if the user enters a start date after the end date or an end date before the start date.

I can't figure out how to get the modified start or end date back to input if the end before start or start after end conditions are violated.

Code is below. It is straightforward. No code for returning the values to input. Lost on that. Thought about using updateDateRangeInput but didn't seem right.

Please help.

I have my UI code:

ui <- fluidPage(
          fluidRow(dateRangeInput(
                             inputId = "mu_date_range",
                             label = "Select Registration Date Range",
                             start = "2021-01-01",
                             end = Sys.Date(),
                             min = "2021-01-01",
                             max = Sys.Date(),
                             format = 'M yyyy',
                             startview = 'year',
                             separator = '-')
          )
          )

And I'm putting an observe() function in server to check the validity of my dates:

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

observe({

  if(mu_date_range[1] <= mu_date_range[2]){
    start <- mu_date_range[1]
  }else{
    start <- mu_date_range[2]
  }

  if(mu_date_range[2] >= mu_date_range[1]){
    end <- mu_date_range[2]
  }else{
    end <- mu_date_range[1]
  }

 })
}

I can't figure out how to then get these validate dates back to input.

CodePudding user response：

updateDateRangeInput is the way to go. First, you need to use input$mu_date_range to access values of the dateRangeInput. Later, according to your validation code, if a user selects an end date after the start date, the start and end dates are going to swap, which I think is a good validation. However, if you want to have the same date after a user selects an invalid date range, you need to use only the valid date as start and end dates. Below is a working code where both options are enabled.

library(shiny)

ui <- fluidPage(
  dateRangeInput(
    inputId = "mu_date_range",
    label = "Select Registration Date Range",
    start = "2021-01-01",
    end = Sys.Date(),
    min = "2021-01-01",
    max = Sys.Date(),
    format = 'M yyyy',
    startview = 'year',
    separator = '-'),
  fluidRow(column(4, verbatimTextOutput("value"))),
  dateRangeInput(
    inputId = "mu_date_range2",
    label = "Select Registration Date Range",
    start = "2021-01-01",
    end = Sys.Date(),
    min = "2021-01-01",
    max = Sys.Date(),
    format = 'M yyyy',
    startview = 'year',
    separator = '-'),
  fluidRow(column(4, verbatimTextOutput("value2")))
)

server <- function(input, output, session) {
  
  output$value <- renderPrint({ input$mu_date_range })
  output$value2 <- renderPrint({ input$mu_date_range2 })
  
  observeEvent(input$mu_date_range, {
    mu_date_range <- input$mu_date_range
    if(mu_date_range[1] <= mu_date_range[2]){
      start <- mu_date_range[1]
    }else{
      start <- mu_date_range[2]
    }
    
    if(mu_date_range[2] >= mu_date_range[1]){
      end <- mu_date_range[2]
    }else{
      end <- mu_date_range[1]
    }
    
    updateDateRangeInput(
      session,
      "mu_date_range",
      start = start,
      end = end
    )
  })
  
  observeEvent(input$mu_date_range2, {
    mu_date_range <- input$mu_date_range2
    if(mu_date_range[1] > mu_date_range[2]){
      mu_date_range[1] <- mu_date_range[2]
    }
    
    if(mu_date_range[2] < mu_date_range[1]){
      mu_date_range[2] <- mu_date_range[1]
    }
    
    updateDateRangeInput(
      session,
      "mu_date_range2",
      start = mu_date_range[1],
      end = mu_date_range[2]
    )
  })
  
}

shinyApp(ui = ui, server = server)

CodePudding user response：

Here's another approach using reactiveValues. You can store your start and end dates in reactiveValues and then use observe to compare with the date range input. The input is also dynamically created in server instead of ui and references the reactiveValues.

library(shiny)

ui <-fluidPage(
  uiOutput("date_range")
)

server <- function(input, output, session) {
  
  rv <- reactiveValues(start = as.Date("2021-01-01"), end = as.Date(Sys.Date()))
  
  observe({
    req(input$mu_date_range)
    
    dates <- as.Date(input$mu_date_range)
    
    if(dates[1] < rv$end) {
      rv$start <- dates[1]
    } else {
      rv$start <- rv$end
    }

    if(dates[2] > rv$start) {
      rv$end <- dates[2]
    } else {
      rv$end <- rv$start
    }
  })
  
  output$date_range <- renderUI({
    dateRangeInput(
      inputId = "mu_date_range",
      label = "Select Registration Date Range",
      start = rv$start,
      end = rv$end,
      min = "2020-01-01",
      max = "2021-12-31",
      format = 'M yyyy',
      startview = 'year',
      separator = '-')
  })
  
}

shinyApp(ui = ui, server = server)