I have a data.table with two columns: "Date" and "Col2". To use this data.table I have built a shiny app with the following two functionality. The first functionality does not allow to put in the "Date" column any type of string but only a date. The second functionality has to do with dateRangeInput().
When I run the shinyApp() containing only one of these functionalities, it works well. However, when I put both functionalities together into one code I am getting an Error in .checkTypos: text string does not conform to standard unambiguous format and the shiny app is getting crashed. This error is popping up when I write some text in the 'Date' column instead of choosing from the drop-down calendar or entering a date in a correct format manually.
I have tried many combinations and alterations but could not escape this error. Can someone show me what I am missing or doing wrong with the code?
Below you find my code with both functionalties integrated.
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(shinyalert)
DF1 <- data.table(
"Date" = as.character(NA),
"Col2" = as.character(NA),
stringsAsFactors = FALSE)
DF2 <- data.table(
"Date" = as.character(NA),
"Col2" = as.character(NA),
stringsAsFactors = FALSE)
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = NULL),
dashboardSidebar(
sidebarMenu(
menuItem("reprex", tabName = "table1")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "table1",
fluidRow(
column(
width = 6,
label = NULL,
rHandsontableOutput("table1Item1")
),
column(
width = 6,
"Choose btw Date and Col2",
selectInput("choices", label=NULL,
choices = c("Filter by Date", "Filter by Col2")),
uiOutput("nested_ui1")
),
column(
width = 6,
label=NULL,
rHandsontableOutput("table1Item2")
)
)
)
)
)
)
)
server = function(input, output, session) {
data <- reactiveValues()
observe({
data$df1 <- as.data.table(DF1)
data$df2 <- as.data.table(DF2)
})
observeEvent(input$table1Item1, {
if (!is.null(input$table1Item1)) {
data$df1 <- hot_to_r(input$table1Item1)
if (any(is.character(as.Date(data$df1$`Date`, format = "%Y-%m-%d")))) {
return()
}
data$df1$`Date` <- format(as.Date(data$df1$`Date`, format = "%Y-%m-%d"), "%Y-%m-%d")
}
})
observe({
if (!is.null(input$table1Item1) && !any(is.na(input$dates1))) {
data$df1 <- hot_to_r(input$table1Item1)
if (!any(is.na(input$dates1)) && input$choices == "Filter by Date") {
from=as.Date(input$dates1[1L])
to=as.Date(input$dates1[2L])
if (from>to) to = from
selectdates1 <- seq.Date(from=from, to=to, by = "day")
data$df2 <- data$df1[as.Date(data$df1$"Date") %in% selectdates1, ]
} else if (!is.null(input$text) && input$choices == "Filter by Col2") {
data$df2 <- data$df1[data$df1$"Col2" == input$text, ]
} else {
selectdates2 <- unique(data$df1$"Date")
data$df2 <- data$df1[data$df1$"Date" %in% selectdates2, ]
}
}
})
output$table1Item1 <- renderRHandsontable({
rhandsontable(data$df1, stretchH = "all", height = 300) |>
hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
})
output$nested_ui1 <- renderUI({
if (input$choices == "Filter by Date") {
dateRangeInput("dates1", "Filter by Date:", format="yyyy-mm-dd",
start = Sys.Date(), end = Sys.Date(), separator = "-")
} else if (input$choices == "Filter by Col2") {
textInput("text", "Filter by Col2:")
}
})
output$table1Item2 <- renderRHandsontable({
rhandsontable(data$df2)
})
}
shinyApp(ui, server)
A simple fix is setting allowInvalid = FALSE in your rhandsontable call:
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(shinyalert)
DF1 <- data.table(
"Date" = as.character(NA),
"Col2" = as.character(NA),
stringsAsFactors = FALSE)
DF2 <- data.table(
"Date" = as.character(NA),
"Col2" = as.character(NA),
stringsAsFactors = FALSE)
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = NULL),
dashboardSidebar(
sidebarMenu(
menuItem("reprex", tabName = "table1")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "table1",
fluidRow(
column(
width = 6,
label = NULL,
rHandsontableOutput("table1Item1")
),
column(
width = 6,
"Choose btw Date and Col2",
selectInput("choices", label=NULL,
choices = c("Filter by Date", "Filter by Col2")),
uiOutput("nested_ui1")
),
column(
width = 6,
label=NULL,
rHandsontableOutput("table1Item2")
)
)
)
)
)
)
)
server = function(input, output, session) {
data <- reactiveValues()
observe({
data$df1 <- as.data.table(DF1)
data$df2 <- as.data.table(DF2)
})
observeEvent(input$table1Item1, {
if (!is.null(input$table1Item1)) {
data$df1 <- hot_to_r(input$table1Item1)
if (any(is.character(as.Date(data$df1$`Date`, format = "%Y-%m-%d")))) {
return()
}
data$df1$`Date` <- format(as.Date(data$df1$`Date`, format = "%Y-%m-%d"), "%Y-%m-%d")
}
})
observe({
if (!is.null(input$table1Item1) && !any(is.na(input$dates1))) {
data$df1 <- hot_to_r(input$table1Item1)
if (!any(is.na(input$dates1)) && input$choices == "Filter by Date") {
from=as.Date(input$dates1[1L])
to=as.Date(input$dates1[2L])
if (from>to) to = from
selectdates1 <- seq.Date(from=from, to=to, by = "day")
data$df2 <- data$df1[as.Date(data$df1$"Date") %in% selectdates1, ]
} else if (!is.null(input$text) && input$choices == "Filter by Col2") {
data$df2 <- data$df1[data$df1$"Col2" == input$text, ]
} else {
selectdates2 <- unique(data$df1$"Date")
data$df2 <- data$df1[data$df1$"Date" %in% selectdates2, ]
}
}
})
output$table1Item1 <- renderRHandsontable({
rhandsontable(data$df1, stretchH = "all", height = 300, allowInvalid = FALSE) |>
hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
})
output$nested_ui1 <- renderUI({
if (input$choices == "Filter by Date") {
dateRangeInput("dates1", "Filter by Date:", format="yyyy-mm-dd",
start = Sys.Date(), end = Sys.Date(), separator = "-")
} else if (input$choices == "Filter by Col2") {
textInput("text", "Filter by Col2:")
}
})
output$table1Item2 <- renderRHandsontable({
rhandsontable(data$df2)
})
}
shinyApp(ui, server)
Another option would be using tryCatch when assigning the data to the reactiveValues:
library(shiny)
library(shinydashboard)
library(rhandsontable)
library(data.table)
library(shinyalert)
DF1 <- data.table(
"Date" = as.character(NA),
"Col2" = as.character(NA),
stringsAsFactors = FALSE)
DF2 <- data.table(
"Date" = as.character(NA),
"Col2" = as.character(NA),
stringsAsFactors = FALSE)
ui <- fluidPage(
dashboardPage(
dashboardHeader(title = NULL),
dashboardSidebar(
sidebarMenu(
menuItem("reprex", tabName = "table1")
)
),
dashboardBody(
tabItems(
tabItem(tabName = "table1",
fluidRow(
column(
width = 6,
label = NULL,
rHandsontableOutput("table1Item1")
),
column(
width = 6,
"Choose btw Date and Col2",
selectInput("choices", label=NULL,
choices = c("Filter by Date", "Filter by Col2")),
uiOutput("nested_ui1")
),
column(
width = 6,
label=NULL,
rHandsontableOutput("table1Item2")
)
)
)
)
)
)
)
server = function(input, output, session) {
data <- reactiveValues()
observe({
data$df1 <- as.data.table(DF1)
data$df2 <- as.data.table(DF2)
})
observeEvent(input$table1Item1, {
if (!is.null(input$table1Item1)) {
data$df1 <- hot_to_r(input$table1Item1)
if (any(is.character(as.Date(data$df1$`Date`, format = "%Y-%m-%d")))) {
return()
}
data$df1$`Date` <- format(as.Date(data$df1$`Date`, format = "%Y-%m-%d"), "%Y-%m-%d")
}
})
observe({
if (!is.null(input$table1Item1) && !any(is.na(input$dates1))) {
tryCatch({
data$df1 <- hot_to_r(input$table1Item1)
if (!any(is.na(input$dates1)) && input$choices == "Filter by Date") {
from=as.Date(input$dates1[1L])
to=as.Date(input$dates1[2L])
if (from>to) to = from
selectdates1 <- seq.Date(from=from, to=to, by = "day")
data$df2 <- data$df1[as.Date(data$df1$"Date") %in% selectdates1, ]
} else if (!is.null(input$text) && input$choices == "Filter by Col2") {
data$df2 <- data$df1[data$df1$"Col2" == input$text, ]
} else {
selectdates2 <- unique(data$df1$"Date")
data$df2 <- data$df1[data$df1$"Date" %in% selectdates2, ]
}
}, error = function(e){print(e)})
}
})
output$table1Item1 <- renderRHandsontable({
rhandsontable(data$df1, stretchH = "all", height = 300) |>
hot_col(1, dateFormat = "YYYY-MM-DD", type = "date")
})
output$nested_ui1 <- renderUI({
if (input$choices == "Filter by Date") {
dateRangeInput("dates1", "Filter by Date:", format="yyyy-mm-dd",
start = Sys.Date(), end = Sys.Date(), separator = "-")
} else if (input$choices == "Filter by Col2") {
textInput("text", "Filter by Col2:")
}
})
output$table1Item2 <- renderRHandsontable({
rhandsontable(data$df2)
})
}
shinyApp(ui, server)