Shiny应用中as.Date()转换日期列致plotly点击子集化报错

问题现象 #

在Shiny应用中使用Plotly的plotly_click事件，通过点击图表上的点来子集化数据时，点击后触发报错：

Error in order: argument 1 is not a vector

原因分析 #

1. 类型不匹配：点击事件返回的event_data中的日期是字符串格式，而原数据的timestamp是POSIXct类型，直接用%in%匹配会引发类型错误。
2. 索引依赖不可靠：原代码通过myPlotEventDataX()[1,3]获取日期的方式依赖固定列索引，一旦event_data结构变化就会出错，应该用预先设置的customdata传递日期值。
3. 匹配逻辑错误：原代码试图用完整的POSIXct时间戳匹配聚合后的日期，而图表上的点是按日期分组的，正确逻辑应该匹配timestamp对应的日期部分。

解决方案 #

1. 从event_data中提取customdata字段（在ggplotly中设置的日期），并转换为Date类型。
2. 筛选数据时，将原数据的timestamp转换为Date后与选中日期匹配。
3. 提取重复逻辑为Reactive变量，减少代码冗余，提升可维护性。

修改后的完整代码 #

library(shiny)
library(shinydashboard)
library(plotly)
library(dplyr)
library(ggplot2)
library(bupaR)

pr59 <- structure(list(case_id = c("WC4120721", "WC4120667", "WC4120689", 
                                 "WC4121068", "WC4120667", "WC4120666", "WC4120667", "WC4121068", 
                                 "WC4120667", "WC4121068"), lifecycle = c(110, 110, 110, 110, 
                                                                          120, 110, 130, 120, 10, 130), action = c("WC4120721-CN354877", 
                                                                                                                   "WC4120667-CN354878", "WC4120689-CN356752", "WC4121068-CN301950", 
                                                                                                                   "WC4120667-CSW310", "WC4120666-CN354878", "WC4120667-CSW308", 
                                                                                                                   "WC4121068-CSW303", "WC4120667-CSW309", "WC4121068-CSW308"), 
                     activity = c("Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", 
                                  "Forged Wire, Medium (Sport)", "Forged Wire, Medium (Sport)", 
                                  "BBH-1&2", "Forged Wire, Medium (Sport)", "TCE Cleaning", 
                                  "SOLO Oil", "Tempering", "TCE Cleaning"), resource = c("3419", 
                                                                                         "3216", "3409", "3201", "C3-100", "3216", "C3-080", "C3-030", 
                                                                                         "C3-090", "C3-080"), timestamp = structure(c(1606964400, 
                                                                                                                                      1607115480, 1607435760, 1607568120, 1607630220, 1607670780, 
                                                                                                                                      1607685420, 1607710800, 1607729520, 1607744100), tzone = "", class = c("POSIXct", 
                                                                                                                                                                                                             "POSIXt")), .order = 1:10), row.names = c(NA, -10L), class = c("eventlog", 
                                                                                                                                                                                                                                                                            "log", "tbl_df", "tbl", "data.frame"), spec = structure(list(
                                                                                                                                                                                                                                                                              cols = list(case_id = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                "collector")), lifecycle = structure(list(), class = c("collector_double", 
                                                                                                                                                                                                                                                                                                                                                                                       "collector")), action = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                           "collector")), activity = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                 "collector")), resource = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                       "collector")), timestamp = structure(list(), class = c("collector_character", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                              "collector"))), default = structure(list(), class = c("collector_guess", 
                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                                    "collector")), delim = ";"), class = "col_spec"), case_id = "case_id", activity_id = "activity", activity_instance_id = "action", lifecycle_id = "lifecycle", resource_id = "resource", timestamp = "timestamp")

ui <- tags$body(
  dashboardPage(
    header = dashboardHeader(), 
    sidebar = dashboardSidebar(), 
    body = dashboardBody(
      plotlyOutput("plot1"),
      plotlyOutput("plot2"),
      plotlyOutput("plot3")
    )
  )
)

server <- function(input, output, session) {
  # 获取三个图表的点击事件数据
  myPlotEventData1 <- reactive({
    event_data(event = "plotly_click", source = "myPlotSource1")
  })
  
  myPlotEventData2 <- reactive({
    event_data(event = "plotly_click", source = "myPlotSource2")
  })
  
  myPlotEventData3 <- reactive({
    event_data(event = "plotly_click", source = "myPlotSource3")
  })
  
  # 提取选中的日期（优先级与原逻辑一致）
  filtered_date <- reactive({
    if (!is.null(myPlotEventData2())) {
      as.Date(myPlotEventData2()$customdata)
    } else if (!is.null(myPlotEventData3())) {
      as.Date(myPlotEventData3()$customdata)
    } else if (!is.null(myPlotEventData1())) {
      as.Date(myPlotEventData1()$customdata)
    } else {
      NULL
    }
  })
  
  # 根据选中日期筛选数据
  filtered_data <- reactive({
    if (!is.null(filtered_date())) {
      pr59 %>% 
        filter(as.Date(timestamp) == filtered_date())
    } else {
      pr59
    }
  })
  
  # 生成图表的通用函数，减少重复代码
  generate_plot <- function(data, title, y_label, source) {
    dat <- data %>% 
      group_by(date = as.Date(timestamp)) %>% 
      bupaR::n_cases()
    
    p <- ggplot(data = dat, aes(x = date, y = n_cases)) +
      geom_area(fill = "#69b3a2", alpha = 0.4) +
      geom_line(color = "#69b3a2", size = 0.5) +
      geom_point(size = 1, color = "#69b3a2") + 
      scale_color_grey() + 
      theme_classic() +
      labs(title = title, x = "日期", y = y_label)
    
    ggplotly(p, source = source, customdata = ~ date)
  }
  
  output$plot1 <- renderPlotly({
    generate_plot(filtered_data(), "每日案例数", "案例数", "myPlotSource1")
  })
  
  output$plot2 <- renderPlotly({
    generate_plot(filtered_data(), "每日案例数", "事件数", "myPlotSource2")
  })
  
  output$plot3 <- renderPlotly({
    generate_plot(filtered_data(), "每日案例数", "对象数", "myPlotSource3")
  })
}

shinyApp(ui, server)

关键修改说明 #

• 统一日期筛选逻辑：用filtered_date和filtered_data两个Reactive变量处理数据筛选，避免重复代码。
• 类型转换：将event_data中的customdata字符串转换为Date类型，确保与原数据的日期部分匹配。
• 通用绘图函数：提取generate_plot函数，减少三个图表的代码冗余，便于后续维护。
• 匹配逻辑修正：使用filter(as.Date(timestamp) == filtered_date())匹配日期部分，而非完整的POSIXct时间戳。

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