堆叠面积图仅x轴上限有数据的类别显示空白，如何添加细条？

我绘制了带右侧标签的堆叠面积图，其中三个Strategy类别仅在x轴最后一个bin（2020-2024）有数据，导致图中顶部显示空白。请问能否在堆叠顶部为这三个类别显示极细的条形？

数据 #

time <- structure(list(Strategy = structure(c(1L, 2L, 3L, 4L, 5L, 6L,
7L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L, 11L, 12L, 13L, 14L,
1L, 2L, 3L, 4L, 5L, 6L, 7L, 9L, 10L, 11L, 12L, 13L, 14L, 15L,
16L, 17L, 18L, 19L, 1L, 2L, 3L, 4L, 5L, 6L, 7L, 8L, 9L, 10L,
11L, 12L, 13L, 14L, 15L, 16L, 17L, 18L, 19L, 20L, 21L, 22L), levels = c("active immunization",
"immune response", "lipid metabolism", "microtubule stabilization",
"oxidative stress", "proteostasis network", "tau enzyme/PTM",
"cell regeneration/restoration", "general neuroprotection", "neuromodulator/transmission",
"non-pharmacological", "passive immunization", "tau aggregation",
"tau reduction", "energy metabolism", "epigenome/transcription",
"metal ion modulation", "neurotrophin pathway", "tau isoform imbalance correction",
"cellular senescence", "combination", "tau propagation"), class = "factor"),
    bin = c("2004-2009", "2004-2009", "2004-2009", "2004-2009",
    "2004-2009", "2004-2009", "2004-2009", "2010-2014", "2010-2014",
    "2010-2014", "2010-2014", "2010-2014", "2010-2014", "2010-2014",
    "2010-2014", "2010-2014", "2010-2014", "2010-2014", "2010-2014",
    "2010-2014", "2010-2014", "2015-2019", "2015-2019", "2015-2019",
    "2015-2019", "2015-2019", "2015-2019", "2015-2019", "2015-2019",
    "2015-2019", "2015-2019", "2015-2019", "2015-2019", "2015-2019",
    "2015-2019", "2015-2019", "2015-2019", "2015-2019", "2015-2019",
    "2020-2024", "2020-2024", "2020-2024", "2020-2024", "2020-2024",
    "2020-2024", "2020-2024", "2020-2024", "2020-2024", "2020-2024",
    "2020-2024", "2020-2024", "2020-2024", "2020-2024", "2020-2024",
    "2020-2024", "2020-2024", "2020-2024", "2020-2024", "2020-2024",
    "2020-2024", "2020-2024"), N = c(1L, 2L, 4L, 1L, 1L, 1L,
    2L, 9L, 3L, 2L, 3L, 1L, 7L, 10L, 3L, 7L, 3L, 8L, 12L, 6L,
    1L, 4L, 16L, 1L, 2L, 5L, 13L, 14L, 3L, 11L, 8L, 35L, 13L,
    1L, 2L, 1L, 1L, 3L, 2L, 4L, 21L, 1L, 2L, 3L, 17L, 20L, 2L,
    26L, 21L, 8L, 27L, 10L, 4L, 5L, 3L, 3L, 2L, 1L, 3L, 2L, 2L
    ), mycolors = c("#97B1BD", "#FBFBB4", "#EBBD63", "#C4D367",
    "#D9B382", "#D9D7C9", "#C8EABC", "#97B1BD", "#FBFBB4", "#EBBD63",
    "#C4D367", "#D9B382", "#D9D7C9", "#C8EABC", "#F0D1E1", "#C3B4D0",
    "#E39699", "#A9A0B2", "#8DD3C7", "#E9877F", "#EED0CD", "#97B1BD",
    "#FBFBB4", "#EBBD63", "#C4D367", "#D9B382", "#D9D7C9", "#C8EABC",
    "#C3B4D0", "#E39699", "#A9A0B2", "#8DD3C7", "#E9877F", "#EED0CD",
    "#C7D98C", "#CDB7CE", "#BE88BF", "#DED7DA", "#CBE5C4", "#97B1BD",
    "#FBFBB4", "#EBBD63", "#C4D367", "#D9B382", "#D9D7C9", "#C8EABC",
    "#F0D1E1", "#C3B4D0", "#E39699", "#A9A0B2", "#8DD3C7", "#E9877F",
    "#EED0CD", "#C7D98C", "#CDB7CE", "#BE88BF", "#DED7DA", "#CBE5C4",
    "#C2ADC0", "#E4EB9C", "#FFED6F"), cum = c(0.5, 2, 5, 7.5,
    8.5, 9.5, 11, 4.5, 10.5, 13, 15.5, 17.5, 21.5, 30, 36.5,
    41.5, 46.5, 52, 62, 71, 74.5, 2, 12, 20.5, 22, 25.5, 34.5,
    48, 56.5, 63.5, 73, 94.5, 118.5, 125.5, 127, 128.5, 129.5,
    131.5, 134, 2, 14.5, 25.5, 27, 29.5, 39.5, 58, 69, 83, 106.5,
    121, 138.5, 157, 164, 168.5, 172.5, 175.5, 178, 179.5, 181.5,
    184, 186)), class = c("data.table", "data.frame"), row.names = c(NA,
-61L))

原代码 #

library(ggplot2)
library(ggrepel)

t_type <- "bin"
p3 <- ggplot(time, aes(x = get(t_type), y = N)) +
  geom_area(
    aes(group = Strategy, fill = Strategy), 
    position = position_stack(reverse = TRUE)
  ) +
  scale_fill_manual(
    values = unique(time$mycolors), 
    labels = unique(time$Strategy)
  ) +
  geom_text_repel(
    data = ~ filter(., get(t_type) == last(time[[t_type]])),
    aes(y = cum, label = Strategy), 
    direction = "y", 
    hjust = "left", 
    segment.color = 'gray',
    na.rm = TRUE,
    xlim = c(4.2, 6),
    ylim = c(0, 200)
  ) +
  scale_y_continuous(limits = c(0, 200), expand = c(0, 0)) +
  scale_x_discrete(expand = expansion(mult = c(0, 0.3))) +
  labs(x = "Year of study", y = "Number of evaluations") +
  theme_classic() +
  theme(
    # text = element_text(family = "Arial"),
    axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1),
    legend.position = 'none'
  )

要实现这个效果，你可以给这三个仅在最后一个时间段有数据的策略，在之前的所有时间段添加极小的数值（比如0.01），这样堆叠面积图会在顶部显示出极细的条形，同时不会影响整体数据的视觉效果。

步骤1：识别目标策略 #

先找出只在2020-2024出现的策略：

# 找出仅在2020-2024存在的策略
unique_strategies <- unique(time$Strategy)
present_in_all_bins <- sapply(unique_strategies, function(s) {
  all(c("2004-2009", "2010-2014", "2015-2019", "2020-2024") %in% time$bin[time$Strategy == s])
})
target_strategies <- unique_strategies[!present_in_all_bins]

步骤2：补充极小值数据 #

为这些策略在之前的时间段添加N=0.01的行，并继承对应的颜色：

library(data.table)

# 获取每个目标策略的颜色
strategy_colors <- unique(time[, .(Strategy, mycolors)])
setkey(strategy_colors, Strategy)

# 生成需要补充的行
missing_rows <- expand.grid(
  Strategy = target_strategies,
  bin = c("2004-2009", "2010-2014", "2015-2019"),
  stringsAsFactors = FALSE
)
missing_rows <- as.data.table(missing_rows)
missing_rows[, N := 0.01]
# 匹配颜色
missing_rows <- strategy_colors[missing_rows]
# 设定极小的cum值，不影响原有堆叠逻辑
missing_rows[, cum := 0.005]

# 合并到原数据并排序
time_updated <- rbind(time, missing_rows)
setorder(time_updated, bin, Strategy)

步骤3：修改绘图代码 #

使用更新后的数据绘图，就能看到顶部的极细条形：

t_type <- "bin"
p3_updated <- ggplot(time_updated, aes(x = get(t_type), y = N)) +
  geom_area(
    aes(group = Strategy, fill = Strategy), 
    position = position_stack(reverse = TRUE)
  ) +
  scale_fill_manual(
    values = unique(time_updated$mycolors), 
    labels = unique(time_updated$Strategy)
  ) +
  geom_text_repel(
    data = ~ filter(., get(t_type) == last(time_updated[[t_type]])),
    aes(y = cum, label = Strategy), 
    direction = "y", 
    hjust = "left", 
    segment.color = 'gray',
    na.rm = TRUE,
    xlim = c(4.2, 6),
    ylim = c(0, 200)
  ) +
  scale_y_continuous(limits = c(0, 200), expand = c(0, 0)) +
  scale_x_discrete(expand = expansion(mult = c(0, 0.3))) +
  labs(x = "研究年份", y = "评估数量") +
  theme_classic() +
  theme(
    axis.text.x = element_text(angle = 45, vjust = 1, hjust = 1),
    legend.position = 'none'
  )

print(p3_updated)

说明 #

• 添加的0.01足够小，不会改变原有堆叠面积的视觉比例，但能让ggplot识别到这些策略在所有时间段都存在，从而画出极细的条形。
• 颜色和原有策略保持一致，保证视觉统一。
• 如果觉得0.01还是太明显，可以调整为更小的数值，比如0.001。

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