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

Question

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)

Answer 1

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