在 dateRangeInput 中防止结束日期在开始日期之前，反之亦然

Question

我有一个dateRangeInput，我想阻止用户输入超过结束日期的开始日期和早于开始日期的结束日期。

我在 UI 中有我的dateRangeInput。然后，我将输入输入到 server 中的 observe 中，以验证并在用户输入结束日期之后的开始日期或开始日期之前的结束日期时使结束日期和开始日期相等。

如果违反了开始前结束或结束后开始条件，我无法弄清楚如何将修改后的开始日期或结束日期重新输入。

代码如下。这很简单。没有用于将值返回到输入的代码。输了。考虑过使用updateDateRangeInput，但似乎不对。

请帮忙。

我有我的 UI 代码：

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

我在server 中添加了一个observe() 函数来检查我的日期的有效性：

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]
  }

 })
}

我不知道如何让这些验证日期返回输入。

Answer 1

这是使用reactiveValues 的另一种方法。您可以将开始和结束日期存储在reactiveValues 中，然后使用observe 与日期范围输入进行比较。输入也是在server 而不是ui 中动态创建的，并引用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)

Answer 2

updateDateRangeInput 是要走的路。首先，您需要使用input$mu_date_range 来访问dateRangeInput 的值。稍后，根据您的验证码，如果用户在开始日期之后选择结束日期，则开始日期和结束日期将交换，我认为这是一个很好的验证。但是，如果您希望在用户选择无效日期范围后具有相同的日期，则只需使用有效日期作为开始日期和结束日期。下面是启用这两个选项的工作代码。

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)