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

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)

CodePudding user response：

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)

CodePudding user response：

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)