rshinyerror-handlingreact-daterange-picker

R - dateRangeInput() - Error: "end date" > "start date"


My shiny app has a data.table to be filtered by a date range. To this end I use dateRangeInput(). When an end date precedes a start date by mistake the R console is giving an Error in seq.int: incorrect sign of argument 'by'.

I went thru the following similar questions in Stackoverflow: question 1 question 2 question 3 question 4 question 5

Solutions given in these questions above I could not assimilate to my case. Below there is the reprex I have tried with an error-handling part added in the code. In the first incidence the error-warning pre-defined by myself is popping up properly when an end date is greater than a start date. However, when I add some more rows of data and try to make a start date posterior to an end date again, then the code is giving an Error in seq.int: incorrect sign of argument 'by' instead of the pre-defined error-warning.

Can someone show me what I am doing wrong or missing in the code?

library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(lubridate)
library(shinyalert)

df <- data.table(
  "Date" = as.character(NA),
  "Col1" = as.character(NA),
  stringsAsFactors = FALSE
)

ui <- fluidPage(
  dashboardPage(
   dashboardHeader(),
   dashboardSidebar(
      sidebarMenu(
        menuItem("Trial", tabName = "trial")
      )
    ),
    dashboardBody(
      tabItems(
        tabItem(tabName = "trial",
          fluidRow(
            column(
              width = 8,
              dateRangeInput("date", label=NULL,
                     start = "2024-01-01", end = Sys.Date()),
              uiOutput("nested_ui")
            ),
            column(
              width = 8,
              rHandsontableOutput("table")
            )
          )
        )
      )
    )
  )
)

server = function(input, output, session) {

  r <- reactiveValues(
    start = ymd("2024-01-01"),
    end = ymd(Sys.Date())
  )

  data <- reactiveValues()

  observe({
    data$dt <- as.data.table(df)
  })

  observe({
    if (!any(is.na(input$date))) {
      selectdates1 <- seq.Date(from=as.Date(input$date[1L]),
                              to=as.Date(input$date[2L]), by = "day")
      data$dt1 <- data$dt[as.Date(data$dt$Date) %in% selectdates1, ]
    } else {
      selectdates2 <- unique(as.Date(data$dt$Date))
      data$dt1 <- data$dt[data$dt$Date %in% selectdates2, ]
    }
  })

  observeEvent(input$date, {
    start <- ymd(input$date[[1]])
    end <- ymd(input$date[[2]])
    if (start >= end) {
      shinyalert("Input error: end date > start date", type = "error")
      updateDateRangeInput(
        session, 
        "date", 
        start = r$start,
        end = r$end
      )
    } else {
      r$start <- input$date[[1]]
      r$end <- input$date[[2]]
    }
  }, ignoreInit = TRUE)

  output$nested_ui <- renderUI({
    !any(is.na(input$date))
  })

  output$table <- renderRHandsontable({
    rhandsontable(data$dt1, stretchH = "all", height = 200) |>
    hot_col(1, dateFormat="YYYY-MM-DD", type="date")
  })

}

shinyApp(ui, server)

Solution

  • Check if the start date is after end date, and reset end to start date. Try this

    server = function(input, output, session) {
      
      r <- reactiveValues(
        start = ymd("2024-01-01"),
        end = ymd(Sys.Date())
      )
      
      data <- reactiveValues()
      
      observe({
        data$dt <- as.data.table(df)
      })
      
      observe({
        if (!any(is.na(input$date))) {
          from=as.Date(input$date[1L])
          to=as.Date(input$date[2L])
          if (from>to) to = from
          selectdates1 <- seq.Date(from=from,
                                   to=to, by = "day")
          data$dt1 <- data$dt[as.Date(data$dt$Date) %in% selectdates1, ]
        } else {
          selectdates2 <- unique(as.Date(data$dt$Date))
          data$dt1 <- data$dt[data$dt$Date %in% selectdates2, ]
        }
      })
      
      observeEvent(input$date, {
        start <- ymd(input$date[[1]])
        end <- ymd(input$date[[2]])
        if (start > end) {
          shinyalert("Input error: end date > start date", type = "error")
          updateDateRangeInput(
            session, 
            "date", 
            start = r$start,
            end = r$start
          )
        } else {
          r$start <- input$date[[1]]
          r$end <- input$date[[2]]
        }
      }, ignoreInit = TRUE)
      
      output$nested_ui <- renderUI({
        !any(is.na(input$date))
      })
      
      output$table <- renderRHandsontable({
        rhandsontable(data$dt1, stretchH = "all", height = 200) |>
          hot_col(1, dateFormat="YYYY-MM-DD", type="date")
      })
      
    }