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

Question

我有一个 Shiny 的应用程序，用户可以选择多个日期范围，我想阻止用户使用 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)

Answer 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)