1

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)

ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
MatCordTo
  • 223
  • 1
  • 7

2 Answers2

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)
ismirsehregal
  • 30,045
  • 5
  • 31
  • 78
  • 1
    The admonishment against the use of `<<-` is *very* good advice. +1 – Limey Jun 30 '22 at 06:48
  • @Limey, I'm not fully sure about banning `<<-` as it's present in many shiny/DT examples [from Yihui himself](https://yihui.shinyapps.io/DT-edit/). Didn't go into details, but what is different here? – Waldi Jun 30 '22 at 08:37
  • 1
    @Waldi. I believe there are legitimate uses for `<<-`, but they are rare. The short answer to why I think `<<-` should be avoided is that I think functions *should not modify environments other than their own*. If they do, then the same code executed before and after the errant function call might produce different results. A more detailed discussion is [here](https://stackoverflow.com/questions/5785290/what-is-the-difference-between-assign-and-in-r), though some of the links are now broken. Other useful discussion exist elsewhere. – Limey Jun 30 '22 at 08:44
  • 1
    @Limey, I agree with your general recommendation. However, I wonder why one of [the developpers of DT](https://www.rstudio.com/authors/yihui-xie/) don't stick to it : I'll try to find out if I have time. – Waldi Jun 30 '22 at 08:50
  • 2
    @Waldi an important difference to note regarding the link you provided is that @YihuiXie is not using `reactiveValues`. I guess `<<-` is used due to its convinience along with the `editData` function - which is fine as long as you aren't planning to trigger other reactives downstream. – ismirsehregal Jun 30 '22 at 09:22
0

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)

enter image description here

Waldi
  • 39,242
  • 6
  • 30
  • 78