使用timevis包的R语言Shiny应用日期异常问题求助

问题根源 #

出现1970年日期异常的核心原因是时间列类型不一致，具体细节：

• 初始timelineData的start列定义为字符型，但首次添加条目时，将input$addStart转成POSIXct类型存入，rbind后该列被强制转换为字符（POSIXct转字符为ISO格式）。
• 代码中observe({timelineData(input$timeline_data)})会直接将timevis组件返回的timeline_data覆盖到timelineData，而input$timeline_data中的start是Unix时间戳（数字），导致start列变成字符与数字混合的类型。
• 后续添加新条目时，rbind操作会将新的POSIXct值转成数字（Unix时间戳），timevis解析错误，将数字当成从1970年开始的毫秒数（实际是秒数），最终显示为1970年。

修复步骤 #

1. 统一时间格式为ISO字符串 #

timevis原生支持ISO格式的时间字符串（如"2024-05-20T12:00:00"），统一用该格式存储可彻底避免类型冲突。

2. 修改添加条目的逻辑 #

将新条目的start转为ISO格式字符串，而非POSIXct类型：

observeEvent(input$addBtn, {
  newItem <- data.frame(
    id = randomID(),
    content = input$addText,
    # 将dateInput输出转为ISO格式字符串
    start = format(as.POSIXct(input$addStart, tz = "UTC"), "%Y-%m-%dT%H:%M:%OS"),
    group = input$addGroup,
    stringsAsFactors = FALSE
  )
  timelineData(rbind(timelineData(), newItem))
})

3. 修正input$timeline_data的处理逻辑 #

timevis返回的timeline_data中start是数字时间戳，需先转为ISO字符串再存入timelineData：

observe({
  req(input$timeline_data)
  updated_data <- input$timeline_data %>%
    mutate(start = ifelse(is.numeric(start), 
                          format(as.POSIXct(start, origin = "1970-01-01", tz = "UTC"), "%Y-%m-%dT%H:%M:%OS"),
                          start))
  timelineData(updated_data)
})

完整修复后的代码 #

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

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 <- 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 = format(as.POSIXct(input$addStart, tz = "UTC"), "%Y-%m-%dT%H:%M:%OS"),
      group = input$addGroup,
      stringsAsFactors = FALSE
    )
    timelineData(rbind(timelineData(), newItem))
  })
  
  output$timeline <- renderTimevis({
    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({
    req(input$timeline_data)
    updated_data <- input$timeline_data %>%
      mutate(start = ifelse(is.numeric(start), 
                            format(as.POSIXct(start, origin = "1970-01-01", tz = "UTC"), "%Y-%m-%dT%H:%M:%OS"),
                            start))
    timelineData(updated_data)
  })
  
}

shinyApp(ui = ui, server = server)

内容的提问来源于stack exchange，提问作者Haribo