如何防止用户使用Shiny dateRangeInput设置开始日期之前的结束日期 [英] How to prevent user from setting the end date before the start date using the Shiny dateRangeInput

问题描述

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

I have a shiny app that a user selects multiple date ranges and I would like to prevent the user from setting the end date before the start date using the dateRangeInput in the lapply function. How do I code this in R? Thanks for looking into this.

这是我的代码

       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)

推荐答案

好的，不要不必要地使其复杂化，我将向您展示一个dateRangeInput()的可能性.

Okay, to not complicate it unnecessarily I will show you a possibility for one dateRangeInput().

简而言之:将开始日期和结束日期存储在reactiveValue()中，并为它们的更新设置一些限制. 例如，如果违反了限制，我选择均等地设置开始日期和结束日期.

In a nutshell: Store the start and end date in a reactiveValue() and set some restrictions for their updates. As an example i chose to set the start and end date equally if your restrictions are violated.

  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()的完整版本，请参见以下内容:

For a full version with multiple dateRangeInput() see below:

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)

这篇关于如何防止用户使用Shiny dateRangeInput设置开始日期之前的结束日期的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！