在Shiny中使用ggplotly交互式柱状图无法获取淋巴瘤类型值的问题

问题背景 #

开发Shiny应用时，通过selectInput选择医生生成对应淋巴瘤类型的柱状图，点击柱子后展示处理该淋巴瘤的医生分布。但使用event_data("plotly_click")$x获取的是柱子的位置数值，而非目标lymphoma_types字符串——悬停时能显示正确值，但点击无法获取。

核心原因 #

代码中用fct_rev(fct_infreq(lymphoma_types))对x轴因子做了频率倒序排序，Plotly会将这类转换后的因子映射为数值型位置，而非原始字符串，导致点击返回的是位置索引而非分类值。

解决方案 #

通过在ggplot的aes中添加customdata传递原始分类值，让Plotly点击事件直接获取目标字符串，具体步骤：

• 在第一个柱状图的ggplot代码中，为aes添加customdata = lymphoma_types，将真实淋巴瘤类型绑定到每个柱子
• 在observeEvent和第二个图表渲染逻辑中，改用event_data("plotly_click")$customdata获取点击的分类值
• 移除原通过位置索引映射分类值的不可靠逻辑

修改后的完整代码 #

library(shiny)
library(ggplot2)
library(plotly)
library(dplyr)
library(forcats)

set.seed(123)
name <- c("Alice", "Bob", "Charlie", "David", "Eve", "Frank", "Grace", "Henry", "Ivy", "Jack", "Kate", "Liam", "Mia", "Noah", "Olivia")
lymphoma_types <- sample(c("DLBCL", "FL", "CLL"), 15, replace = TRUE)
Doctor <- sample(c("Quentin", "Rachel", "Samuel"), 15, replace = TRUE)

cdt <- data_frame(name, Doctor, lymphoma_types)    # My dataframe

ui <- fluidPage(
  sidebarLayout(
    sidebarPanel(
      selectInput("Doc", "Doctor", choices = unique(cdt$Doctor))  # 优化：去重选项
    ),
    mainPanel(
      plotlyOutput("colplot"),
      plotlyOutput("second_plot")
    )
  )
)

server <- function(input, output, session) {
  selected <- reactive({
    cdt %>%
      filter(Doctor == input$Doc)
  })
  
  clicked_value <- reactiveVal(NULL)
  
  output$colplot <- renderPlotly({
    if (nrow(selected()) == 0) {
      return(NULL)
    }
    
    p <- ggplot(selected(), aes(x = fct_rev(fct_infreq(lymphoma_types)), 
                                fill = lymphoma_types,
                                customdata = lymphoma_types)) +  # 绑定真实分类值
      geom_bar() +
      coord_flip() +
      theme_minimal() +
      labs(x = "Lymphoma Type")
    
    ggplotly(p) %>%
      event_register("plotly_click")
  })
  
  observeEvent(event_data("plotly_click"), {
    # 从customdata获取真实淋巴瘤类型
    clicked_value(event_data("plotly_click")$customdata)
  })
  
  output$second_plot <- renderPlotly({
    clicked_lymphoma <- clicked_value()
    
    if (is.null(clicked_lymphoma)) {
      return(NULL)
    }
    
    # 直接用分类值过滤数据
    filtered_data <- cdt %>%
      filter(lymphoma_types == clicked_lymphoma)
    
    p <- ggplot(filtered_data, aes(x = Doctor)) +
      geom_bar(fill = "#636EFA") +
      theme_minimal() +
      labs(title = paste("Frequency of doctors for", clicked_lymphoma),
           x = "Doctor", y = "Count")
    
    ggplotly(p)
  })
}
shinyApp(ui, server)

额外优化点 #

• selectInput选项改用unique(cdt$Doctor)，避免重复选项
• 为图表添加清晰的坐标轴标签
• 统一第二个图表的填充色，提升视觉一致性

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