如何使用 Shiny dateRangeInput 防止用户在开始日期之前设置结束日期答案

【问题标题】：How to prevent user from setting the end date before the start date using the Shiny dateRangeInput如何使用 Shiny dateRangeInput 防止用户在开始日期之前设置结束日期
【发布时间】：2017-09-22 16:56:59
【问题描述】：

我有一个闪亮的应用程序，用户选择多个日期范围，我想防止用户使用 lapply 函数中的 dateRangeInput 设置开始日期之前的结束日期。我如何在 R 中编写代码？感谢您查看这个。

这是我的代码

       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)

【问题讨论】：

标签： r date shiny lapply

【解决方案1】：

好的，为了避免不必要地复杂化，我将向您展示dateRangeInput() 的可能性。

简而言之：将开始和结束日期存储在 reactiveValue() 中，并为其更新设置一些限制。例如，如果您的限制被违反，我选择同等设置开始日期和结束日期。

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

对于具有多个dateRangeInput() 的完整版本，请参见下文：

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)

【讨论】：

嗨大数据科学家。感谢您花时间研究此代码。我知道我的代码使用 dateRangeInput 的 lapply 函数很复杂。我是 R 和 Shiny 的新手，我会学习这门语言的来龙去脉。我希望将 observeEvent 用于此过程，您可以根据用户的开始日期输入更新结束日期，以防止他在开始日期之前设置结束日期。我们或许可以在 observeEvent 中使用 UpdateDateRangeInput。
但是，当您有多个日期范围时，我不知道如何在 observeEvent 中使用它。我可以使用单个日期范围对其进行编码。希望您能提供帮助，因为您在 R 和 Shiny 方面有丰富的经验，感谢您的宝贵时间。
1) 它与复杂的代码无关，最终它并不那么复杂。这是关于有一个通用的问题/答案，其他有类似问题的用户可以从 2) 中受益，最后我们在这里帮助您从您的尝试中获得解决方案，..而不是编写完整的代码。 3）所以我希望你可以为单个 dateRange 编写代码，然后向我们展示代码，而不是让它再次重做？？？
对于具有多个 dateRangeInputs 的版本，请参阅编辑。

【解决方案2】：

我遇到过这个问题，但以不同的方式解决了它。我只是假设用户选择了他们想要的日期范围，然后使用最大值和最小值。

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

问题解决了。适用于困惑的用户。

【讨论】：