Date - time issue on timevis in shiny app in R

Question

I have a shiny app which I would like to use the timevis package for Gantt chart :

library(timevis)
library(shiny)

ui <- fluidPage(
  textAreaInput("addText", "Add item:", "service: \n Cost: "),
  dateInput("addDate", NULL, Sys.Date()),
  textAreaInput("group", "Add group:", "Owner:"),
  actionButton("addBtn", "Add"),
  timevisOutput("timelineInteractive"),
  tableOutput("table")
)

server <- function(input, output, session) {
  data_rv <- reactiveValues(data = data.frame(start = as.POSIXct(character(), tz = "UTC"), 
                                              end = as.POSIXct(character(), tz = "UTC"), 
                                              content = character(), 
                                              group = character(), 
                                              stringsAsFactors = FALSE),
                            userUpdated = FALSE)
  
  groups <- reactive({
    if(nrow(data_rv$data) == 0) {
      NULL
    } else {
      data.frame(id = unique(data_rv$data$group), 
                 content = unique(data_rv$data$group))
    }
  })
  
  observeEvent(input$addBtn, {
    new_item <- data.frame(start = as.POSIXct(input$addDate, tz = "UTC"),
                           end = NA,
                           content = gsub("\n", "<br>", input$addText),
                           group = input$group,
                           stringsAsFactors = FALSE)
    
    data_rv$data <- rbind(data_rv$data, new_item)
    data_rv$userUpdated <- FALSE
  })
  
  output$timelineInteractive <- renderTimevis({
    config <- list(
      editable = TRUE,
      multiselect = TRUE
    )
    timevis(data = data_rv$data, groups = groups(), options = config)
  })
  
  observeEvent(input$timelineInteractive_data, {
    if (!data_rv$userUpdated) {
      timeline_data <- input$timelineInteractive_data
      
      timeline_data$start <- as.POSIXct(timeline_data$start, format = "%Y-%m-%dT%H:%M:%OSZ", tz = "UTC")
      if ("end" %in% names(timeline_data)) {
        timeline_data$end <- as.POSIXct(timeline_data$end, format = "%Y-%m-%dT%H:%M:%OSZ", tz = "UTC")
      } else {
        timeline_data$end <- NA
      }
      
      timeline_data <- timeline_data[ , c("start", "end", "content", "group")]
      names(timeline_data) <- c("start", "end", "content", "group")
      
      data_rv$userUpdated <- TRUE
      
      data_rv$data <- timeline_data
    } else {
      data_rv$userUpdated <- FALSE
    }
  })
  
  output$table <- renderTable({
    data <- input$timelineInteractive_data
    data
  })
}

shinyApp(ui = ui, server = server)

App is working but it is not getting the correct date :( ! Whatever I pick from dateInput is going to appear both on timevis and table, a day before at 22:00:00 ! and I have no idea how to fix it !

Answer 1

The reason is simple: While, as also given in your code, all timestamps are given in UTC, the app displays them in local time. You can solve this problem by converting the start and end values in the desired time zone. The following should work using lubridate::with_tz with tzone = Sys.timezone().

library(timevis)
library(shiny)

ui <- fluidPage(
    textAreaInput("addText", "Add item:", "service: \n Cost: "),
    dateInput("addDate", NULL, Sys.Date()),
    textAreaInput("group", "Add group:", "Owner:"),
    actionButton("addBtn", "Add"),
    timevisOutput("timelineInteractive"),
    tableOutput("table")
)

server <- function(input, output, session) {
    data_rv <- reactiveValues(data = data.frame(start = as.POSIXct(character(), tz = "UTC"), 
                                                end = as.POSIXct(character(), tz = "UTC"), 
                                                content = character(), 
                                                group = character(), 
                                                stringsAsFactors = FALSE),
                              userUpdated = FALSE)
    
    groups <- reactive({
        if(nrow(data_rv$data) == 0) {
            NULL
        } else {
            data.frame(id = unique(data_rv$data$group), 
                       content = unique(data_rv$data$group))
        }
    })
    
    observeEvent(input$addBtn, {
        new_item <- data.frame(start = lubridate::with_tz(as.POSIXct(input$addDate, tz = "UTC"), tzone = Sys.timezone()),
                               end = NA,
                               content = gsub("\n", "<br>", input$addText),
                               group = input$group,
                               stringsAsFactors = FALSE)
        
        data_rv$data <- rbind(data_rv$data, new_item)
        data_rv$userUpdated <- FALSE
    })
    
    output$timelineInteractive <- renderTimevis({
        config <- list(
            editable = TRUE,
            multiselect = TRUE
        )
        timevis(data = data_rv$data, groups = groups(), options = config,
                timezone = 0)
    })
    
    observeEvent(input$timelineInteractive_data, {
        if (!data_rv$userUpdated) {
            timeline_data <- input$timelineInteractive_data
            
            timeline_data$start <- lubridate::with_tz(as.POSIXct(timeline_data$start, format = "%Y-%m-%dT%H:%M:%OSZ", tz = "UTC"),
                                             tzone = Sys.timezone())
            if ("end" %in% names(timeline_data)) {
                timeline_data$end <- lubridate::with_tz(as.POSIXct(timeline_data$end, format = "%Y-%m-%dT%H:%M:%OSZ", tz = "UTC"),
                                                        tzone = Sys.timezone())
            } else {
                timeline_data$end <- NA
            }
            
            timeline_data <- timeline_data[ , c("start", "end", "content", "group")]
            names(timeline_data) <- c("start", "end", "content", "group")
            
            data_rv$userUpdated <- TRUE
            
            data_rv$data <- timeline_data
        } else {
            data_rv$userUpdated <- FALSE
        }
    })
    
    output$table <- renderTable({
        data <- input$timelineInteractive_data
        data
    })
}

shinyApp(ui = ui, server = server)