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

Posted 2023-02-14

【中文标题】在 dateRangeInput 中防止结束日期在开始日期之前，反之亦然

【英文标题】：Prevent End Date Before Start Date and Vice Versa in dateRangeInput

【发布时间】：2022-01-20 17:02:30

【问题描述】：

我有一个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]
  

 )

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

【参考方案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)

【讨论】：

虽然这两个答案都很好地解决了我的问题，但这个答案赢得了“最佳”，因为它很好地最小化了 UI 中的代码并将所有计算移至服务器

【参考方案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)

【讨论】：

感谢您的快速回复。看了一眼，我自己永远也想不通。将研究它以确保我理解并可能会向您提出问题。