Empty Date fields in data table generate error in shiny app - r

Question

I have the following shiny app where the user can change the values of a table, however, if the user leaves an empty date field it generates an error but I don't know how to solve it.
I have tried to put the new value as as.character, as.Date, as.Posixct but it has not worked, I would appreciate any kind of guidance or help.
This is the message that the console throws:
Warning: Error in charToDate: character string is not in a standard unambiguous format
[No stack trace available]
Thank you
library(shiny)
#library(shinyjs)
library(DT)
#library(data.table)
#library(shinyalert)
#library(openxlsx)
#library(shinyFiles)
#library(dplyr)
#library(stringi)
#useShinyalert()
df <- data.frame(
Var1 = letters[1:10],
Var2 = round(rnorm(10),3),
Date1 = seq(as.Date("2000/01/01"), by = "month", length.out = 10),
Date2 = seq(as.Date("2000/01/01"), by = "month", length.out = 10)
)
d1 <- reactiveValues()
d1$Data <- df
server <- function(input, output, session){
# RENDER TABLE ----
data.tabla <- reactive({
df <- d1$Data
return(df)
})
output$df_data <- renderDataTable({
df <- datatable(
data.tabla(),
selection = 'single', editable = TRUE, rownames = FALSE,
options = list(
paging = TRUE,
# scrollX = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering= FALSE,
dom = 'Bfrtip',
buttons = c('excel')
),
class = "display"
)
return(df)
})
observeEvent(input$df_data_cell_edit, {
d1$Data[input$df_data_cell_edit$row,
input$df_data_cell_edit$col+1] <<- input$df_data_cell_edit$value
})
}
# UI ----
ui <- fluidPage(
sidebarPanel(),
mainPanel(
DT::dataTableOutput("df_data"))
)
shinyApp(ui, server)

Answer 1

You should not use the global assignment operator <<- along with reactiveValues. Please try the following:
library(shiny)
library(DT)
DF <- data.frame(
Var1 = letters[1:10],
Var2 = round(rnorm(10), 3),
Date1 = seq(as.Date("2000/01/01"), by = "month", length.out = 10),
Date2 = seq(as.Date("2000/01/01"), by = "month", length.out = 10)
)
d1 <- reactiveValues(Data = DF)
server <- function(input, output, session) {
DT <- reactive({
d1$Data
})
output$df_data <- renderDataTable({
datatable(
DT(),
selection = 'single',
editable = TRUE,
rownames = FALSE,
options = list(
paging = TRUE,
# scrollX = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering = FALSE,
dom = 'Bfrtip',
buttons = c('excel')
),
class = "display"
)
})
observeEvent(input$df_data_cell_edit, {
d1$Data[input$df_data_cell_edit$row, input$df_data_cell_edit$col + 1] <- input$df_data_cell_edit$value
})
}
ui <- fluidPage(sidebarPanel(), mainPanel(DT::dataTableOutput("df_data")))
shinyApp(ui, server)

Answer 2

You could check that the Date columns are in proper Date format:
library(shiny)
df <- data.frame(
Var1 = letters[1:10],
Var2 = round(rnorm(10),3),
Date1 = seq(as.Date("2000/01/01"), by = "month", length.out = 10),
Date2 = seq(as.Date("2000/01/01"), by = "month", length.out = 10)
)
d1 <- reactiveValues()
d1$Data <- df
server <- function(input, output, session){
# RENDER TABLE ----
data.tabla <- reactive({
df <- d1$Data
return(df)
})
output$df_data <- renderDataTable({
df <- datatable(
data.tabla(),
selection = 'single', editable = TRUE, rownames = FALSE,
options = list(
paging = TRUE,
# scrollX = TRUE,
searching = TRUE,
fixedColumns = TRUE,
autoWidth = TRUE,
ordering= FALSE,
dom = 'Bfrtip',
buttons = c('excel')
),
class = "display"
)
return(df)
})
observeEvent(input$df_data_cell_edit, {
value <- input$df_data_cell_edit$value
row <- input$df_data_cell_edit$row
col <- input$df_data_cell_edit$col + 1
if (col >= 3 & tryCatch({
as.Date(value); TRUE},error = function(err) {FALSE}) ) {
d1$Data[row,col] <<- input$df_data_cell_edit$value
} else {
showModal(modalDialog(
title = "Wrong date format",
"Check date format!"
))
d1$Data[row,col] <- NA
}
})
}
# UI ----
ui <- fluidPage(
sidebarPanel(),
mainPanel(
DT::dataTableOutput("df_data"))
)
shinyApp(ui, server)