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