如何在R语言plotly带滑块的堆叠条形图中显示图例

我用R语言的plotly包制作带滑块的堆叠条形图，参考了plotly官网的滑块示例，但图例无法正常显示，怀疑是legendgroup参数使用不当。当前代码如下：

summary <- structure(list(Language = c("English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German"), category = structure(c(1L, 1L, 1L, 1L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L), levels = c("A", "B", "C", "D"), class = "factor"), Year = c(2000, 2001, 2002, 2003, 2002, 2000, 2001, 2002, 2003, 2000, 2001, 2002, 2003, 2000, 2001, 2002, 2003, 2000, 2001, 2003, 2000, 2001, 2002, 2003, 2001, 2002, 2003), n = c(20L, 39L, 41L, 53L, 1L, 3L, 12L, 8L, 22L, 2L, 11L, 17L, 18L, 44L, 29L, 38L, 46L, 1L, 3L, 3L, 2L, 1L, 2L, 4L, 1L, 3L, 3L)), row.names = c(NA, -27L), class = "data.frame")

library(plotly)

# Create data for different traces
traces <- list()
unique_years <- unique(summary$Year) %>% sort
unique_disciplines <- unique(summary$category)
n_colors <- length(unique_disciplines)
colors <- rainbow(n_colors)

for (i in 1:length(unique_years)) {
  year <- unique_years[i]
  trace <- list(
    visible = FALSE,
    name = paste0('Year = ', year),
    x = summary$Language[summary$Year == year],
    y = summary$n[summary$Year == year],
    color = summary$category[summary$Year == year]
  )
  traces[[i]] <- trace
}
traces[[1]]$visible <- TRUE  # Make the first trace visible by default

# Create steps for the slider
steps <- list()
for (i in 1:length(unique_years)) {
  step <- list(
    method = "restyle",
    args = list("visible", rep(FALSE, length(traces))),
    label = paste0('Year = ', unique_years[i])
  )
  step$args[[2]][i] <- TRUE
  steps[[i]] <- step
}
# Create the graph
fig <- plot_ly()
for (i in 1:length(traces)) {
  fig <- fig %>% add_bars(
    type = 'bar', 
    x = traces[[i]]$x,
    y = traces[[i]]$y,
    visible = traces[[i]]$visible,
    marker = list(color = colors[traces[[i]]$color]),
    # The problem comes from the following line probably:
    legendgroup = traces[[i]]$color 
  )
}

# Add the slider to the graph
fig <- fig %>% layout(
  sliders = list(list(active = 1, currentvalue = list(prefix = "Year: "), steps = steps)),
  yaxis = list(title = "Count"),
  barmode = "stack"
)

# Display the graph
fig

当前图表效果：

问题根源 #

1. Trace分组逻辑错误：原代码按年份整组创建trace，每个年份的trace包含多个类别（A/B/C/D），导致plotly无法识别独立的图例项。
2. Legendgroup参数误用：直接将多值向量传给legendgroup，但每个trace只能对应单个图例组。
3. 未设置图例名称：没有为每个类别指定name，plotly无法生成对应的图例标签。

修正后的代码 #

summary <- structure(list(Language = c("English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "English", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German", "German"), category = structure(c(1L, 1L, 1L, 1L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L, 4L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 4L, 4L, 4L), levels = c("A", "B", "C", "D"), class = "factor"), Year = c(2000, 2001, 2002, 2003, 2002, 2000, 2001, 2002, 2003, 2000, 2001, 2002, 2003, 2000, 2001, 2002, 2003, 2000, 2001, 2003, 2000, 2001, 2002, 2003, 2001, 2002, 2003), n = c(20L, 39L, 41L, 53L, 1L, 3L, 12L, 8L, 22L, 2L, 11L, 17L, 18L, 44L, 29L, 38L, 46L, 1L, 3L, 3L, 2L, 1L, 2L, 4L, 1L, 3L, 3L)), row.names = c(NA, -27L), class = "data.frame")

library(plotly)
library(dplyr)

# 基础参数准备
unique_years <- sort(unique(summary$Year))
unique_categories <- unique(summary$category)
color_pal <- rainbow(length(unique_categories))
names(color_pal) <- unique_categories

# 按「类别+年份」拆分创建trace
traces <- list()
trace_idx <- 1

for (cat in unique_categories) {
  for (year in unique_years) {
    # 筛选对应年份和类别的数据，无数据时补0
    df_filtered <- summary %>% filter(Year == year, category == cat)
    if (nrow(df_filtered) == 0) {
      df_filtered <- data.frame(Language = unique(summary$Language), n = 0)
    }
    
    # 默认仅显示第一个年份的所有类别
    visible <- (year == unique_years[1])
    
    traces[[trace_idx]] <- list(
      type = "bar",
      x = df_filtered$Language,
      y = df_filtered$n,
      name = as.character(cat),
      legendgroup = as.character(cat),
      marker = list(color = color_pal[cat]),
      visible = visible
    )
    trace_idx <- trace_idx + 1
  }
}

# 构建滑块切换逻辑
steps <- list()
for (i in seq_along(unique_years)) {
  year <- unique_years[i]
  # 计算当前年份对应的trace索引范围
  start_idx <- (i - 1) * length(unique_categories) + 1
  end_idx <- i * length(unique_categories)
  
  visible_vec <- rep(FALSE, length(traces))
  visible_vec[start_idx:end_idx] <- TRUE
  
  steps[[i]] <- list(
    method = "restyle",
    args = list("visible", visible_vec),
    label = paste("年份:", year)
  )
}

# 生成图表
fig <- plot_ly() %>%
  add_traces(data = traces) %>%
  layout(
    sliders = list(list(
      active = 0,
      currentvalue = list(prefix = "当前年份: "),
      steps = steps
    )),
    yaxis = list(title = "数量"),
    barmode = "stack",
    legend = list(title = list(text = "类别"))
  )

fig

关键修正说明 #

1. 拆分Trace结构：为每个类别的每个年份单独创建trace，确保每个trace对应一个图例项。
2. 统一Legendgroup：同一类别的所有年份trace使用相同的legendgroup，保证图例交互时能批量控制同类别数据。
3. 补全缺失数据：处理无数据的年份-类别组合，避免堆叠条形图错位。
4. 调整滑块逻辑：滑块切换时，控制对应年份的所有类别trace显示，其他年份隐藏。

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