daattali / timevis

📅 Create interactive timeline visualizations in R
http://daattali.com/shiny/timevis-demo/
Other
655 stars 157 forks source link

wrong date on timeline #139

Closed alipprc closed 1 year ago

alipprc commented 1 year ago

I have tried to combine the grouping feature and interactive feature from your example to create a shiny app, asking for a date and group, to add the new item on timeline using timevis, also I want to be able to remove the item either using remove dropdown or select and remove directly on timeline. All features are working, but I don't know why there is a strange behavior is in time input ! The first input get the correct date but any additional input will appears on 1970 !

library(shiny)
library(timevis)
library(dplyr)

randomID <- function() {
  paste(sample(c(letters, LETTERS, 0:9), 16, replace = TRUE), collapse = "")
}

prettyDate <- function(d) {
  if (is.null(d)) return()
  posix <- as.POSIXct(d, format = "%Y-%m-%dT%H:%M:%OS", tz = "UTC")
  corrected <- lubridate::with_tz(posix, tzone = Sys.timezone())
  format(corrected, "%Y-%m-%d %H:%M:%OS %Z")
}

ui <- fluidPage(
  timevisOutput("timeline"),
  textInput("addText", tags$h4("Add item:"), "New item"),
  dateInput("addStart", "Start date:", Sys.Date()),
  textInput("addGroup", "Group:", "gym"),
  actionButton("addBtn", "Add"),
  uiOutput("removeIdsOutput", inline = TRUE),
  actionButton("removeItem", "Remove"),
  tableOutput("table")
)

server <- function(input, output, session) {

  timelineData <- reactiveVal(data.frame(id = character(), 
                                         content = character(),
                                         start = character(),
                                         group = character(),
                                         type = character(), 
                                         stringsAsFactors = FALSE))

  observeEvent(input$addBtn, {
    newItem <- data.frame(id = randomID(),
                          content = input$addText,
                          start = as.POSIXct(input$addStart, tz = "UTC"),
                          group = input$addGroup,

                          stringsAsFactors = FALSE)
    timelineData(rbind(timelineData(), newItem))
  })

  output$timeline <- renderTimevis({
    # Creating the groups data.frame
    groupList <- unique(timelineData()$group)
    groupData <- data.frame(id = groupList, content = groupList)

    timevis(data = timelineData(), groups = groupData, options = list(editable = TRUE))
  })

  output$table <- renderTable({
    data <- timelineData()
    data$start <- prettyDate(data$start)
    data
  })

  output$removeIdsOutput <- renderUI({
    if(nrow(timelineData()) > 0){
      selectInput("removeIds", tags$h4("Remove item"), timelineData()$id)
    }else{
      NULL
    }
  })

  observeEvent(input$removeItem, {
    if(!is.null(input$removeIds)){
      timelineData(timelineData() %>%
                     filter(id != input$removeIds))
    }
  })

  observe({
    timelineData(input$timeline_data)
  })

}

shinyApp(ui = ui, server = server)
daattali commented 1 year ago

There is too much code here to be able to know that the issue is with timevis and not with the code. Please share a reprex (minimum reproducible example) that clearly and concisely shows a bug

daattali commented 1 year ago

I tried taking a quick look but there is too much happening in this app, I really think the bug is with the code rather than with timevis unless you can prove otherwise.

daattali commented 1 year ago

Closing this due to no response. If you still think there's a bug in timevis, please share a SMALL example highlighting the bug.