ggplot实现每个ID对应两组带状态符号的柱状图及排序问题

我需要绘制每个ID包含2个分组的柱状图，要求：

• 每个柱子显示ongoing、pd、+B对应的状态符号
• 柱子上方显示duration数值
  但目前遇到三个问题：

1. 无法显示各分组的专属状态符号
2. duration文本位置存在偏移
3. 不知道如何按group 1的duration降序排列X轴的ID

以下是我目前的可复现代码及生成的图表：

df <- as.data.frame(cbind(id = rep(seq(1:30), 2),
                          group = c(rep(1, 30), rep(2, 30)),
                          duration = sample(0:10, replace = T),
                          ongoing = rbinom(n=60, size = 1, prob = 0.5),
                          pd = rbinom(n=60, size=1, prob = 0.5),
                          cat = rbinom(n=60, size=1, prob = 0.5)))


longdf <- df %>%
  dplyr::filter(ongoing == 1) %>%
  dplyr::mutate(time = duration+0.3, type = 'Ongoing') %>%
  dplyr::select(id, group, time, type) %>%
  # PD
  rbind(dplyr::filter(df) %>%
          dplyr::filter(pd == 1) %>%
          dplyr::mutate(time = 2, type = 'PD') %>%
          dplyr::select(id, group, time, type)) %>%
  # cat
  rbind(dplyr::filter(df) %>%
          dplyr::filter(cat == 1) %>%
          dplyr::mutate(time = 3, type = '+B') %>%
          dplyr::select(id, group, time, type)) %>%
  # duration text
  rbind(dplyr::filter(df) %>%
          dplyr::mutate(time = duration+0.1, 
                        type = as.character(round(duration, 1))) %>%
          dplyr::select(id, group, time, type))

typeLevels <- c('PD', '+B')

shapedf <- longdf %>%
  dplyr::filter(type %in% c('PD', '+B')) %>%
  dplyr::mutate(type = factor(type, levels = typeLevels)) %>%
  dplyr::arrange(desc(type)) 

textdf <- longdf %>%
  dplyr::filter(grepl('\\d+', type))

arrowdf <- longdf %>%
  dplyr::filter(type == 'Ongoing') %>%
  dplyr::mutate(time1 = time-0.1, time2 = time+0.1, type = group, 
                lane.col = 'red') %>%
  dplyr::select(id, group, lane.col, type, time1, time2)

plot1 <- ggplot(df, aes(x = reorder(id, desc(duration)), y = duration)) +
  geom_bar(stat = 'identity', position = 'dodge', aes(fill = factor(group))) +
  geom_point(data = shapedf[shapedf$type %in% c('PD', '+B'),],
             aes(id, time, colour = type, shape = type), size = 2) +
  geom_text(data = textdf, aes(id, time, label = type), size = 2) +
  geom_segment(data = arrowdf, aes(x = id, xend = id, y = time1, yend = time2),
               arrow = arrow(length = unit(0.2, 'cm'), type = 'closed'), size = 1, 
               colour = arrowdf$lane.col, show.legend = F) +
  xlab('') + ylab('Duration\n') +
  theme(plot.title = element_text(hjust = 0.5, face = 'bold'), plot.subtitle = element_text(hjust = 0.5),
        legend.title = element_blank(), legend.position = c(0.75, 0.7), 
        panel.background = element_rect(fill = 'white'), axis.ticks.y = element_blank(),
        axis.line.x = element_line(size = 0.5, colour = 'black'),
        axis.text.x = element_text(size = 10, face = 'bold', angle = 90),
        axis.text.y = element_text(size = 10, face = 'bold'), legend.text = element_text(size = 15),
        legend.spacing.y = unit(-0.2, 'cm'), legend.background = element_rect(color = 'white'),
        legend.key.size = unit(0.5, 'cm'), legend.key = element_blank()) +
  scale_y_continuous(expand = c(0.01,0), limits = c(-0.5, 10), breaks = seq(0, 10, by=1)) +
  scale_fill_manual(values = c(charcoal, 'dark grey', 'light grey')) + 
  scale_colour_manual(values = c('green', 'orange'),
                      breaks = c('PD', '+B')) +
  scale_shape_manual(values = c(4, 3),
                     breaks = c('PD', '+B')) +
  guides(fill = guide_legend(order = 2), shape = guide_legend(override.aes = list(size = 5))) 

plot1

1. 按group 1的duration降序排列X轴ID #

提取group 1的duration数据，用它来重新定义id的因子水平，确保X轴排序完全依据group1的数值：

# 获取group1的duration排序结果
group1_order <- df %>%
  filter(group == 1) %>%
  arrange(desc(duration)) %>%
  pull(id)

# 将id转为按group1_order排序的因子
df <- df %>%
  mutate(id = factor(id, levels = group1_order))

2. 显示各分组专属状态符号 #

原代码未区分分组，导致符号叠加在同一X位置。需在aes中加入group参数，配合position_dodge让符号对应到各自分组的柱子上方：

geom_point(data = shapedf,
           aes(x = id, y = time, colour = type, shape = type, group = group), 
           size = 2, position = position_dodge(width = 0.9))

同时调整ongoing箭头的X位置，让它匹配对应分组的柱子：

arrowdf <- arrowdf %>%
  mutate(x_pos = as.numeric(id) + ifelse(group == 1, -0.4, 0.4)) # 偏移量与柱状图dodge宽度匹配

# 绘制箭头时用x_pos替代原id
geom_segment(data = arrowdf, aes(x = x_pos, xend = x_pos, y = time1, yend = time2),
             arrow = arrow(length = unit(0.2, 'cm'), type = 'closed'), size = 1, 
             colour = 'red', show.legend = F)

3. 修正duration文本位置偏移 #

给geom_text添加group和position_dodge，同时调整Y轴偏移量让文本精准显示在柱子顶部：

geom_text(data = textdf, 
          aes(x = id, y = duration + 0.3, label = type, group = group), 
          size = 2, position = position_dodge(width = 0.9))

完整修正代码 #

library(ggplot2)
library(dplyr)

# 生成数据并修正类型
df <- as.data.frame(cbind(id = rep(seq(1:30), 2),
                          group = c(rep(1, 30), rep(2, 30)),
                          duration = sample(0:10, replace = T),
                          ongoing = rbinom(n=60, size = 1, prob = 0.5),
                          pd = rbinom(n=60, size=1, prob = 0.5),
                          cat = rbinom(n=60, size=1, prob = 0.5))) %>%
  mutate(across(c(id, group, duration, ongoing, pd, cat), as.numeric))

# 按group1的duration降序排序id
group1_order <- df %>%
  filter(group == 1) %>%
  arrange(desc(duration)) %>%
  pull(id)
df <- df %>%
  mutate(id = factor(id, levels = group1_order))

# 整理状态数据
longdf <- df %>%
  filter(ongoing == 1) %>%
  mutate(time = duration + 0.5, type = 'Ongoing') %>%
  select(id, group, time, type) %>%
  rbind(df %>%
          filter(pd == 1) %>%
          mutate(time = duration + 0.8, type = 'PD') %>%
          select(id, group, time, type)) %>%
  rbind(df %>%
          filter(cat == 1) %>%
          mutate(time = duration + 1.1, type = '+B') %>%
          select(id, group, time, type)) %>%
  rbind(df %>%
          mutate(type = as.character(round(duration, 1))) %>%
          select(id, group, duration, type))

# 拆分数据框
shapedf <- longdf %>%
  filter(type %in% c('PD', '+B'))
textdf <- longdf %>%
  filter(grepl('\\d+', type))
arrowdf <- longdf %>%
  filter(type == 'Ongoing') %>%
  mutate(time1 = time - 0.1, time2 = time + 0.1,
         x_pos = as.numeric(id) + ifelse(group == 1, -0.4, 0.4)) # 分组偏移

# 绘制图表
plot1 <- ggplot(df, aes(x = id, y = duration)) +
  geom_bar(stat = 'identity', position = position_dodge(width = 0.9), aes(fill = factor(group))) +
  # 状态符号
  geom_point(data = shapedf,
             aes(x = id, y = time, colour = type, shape = type, group = group), 
             size = 2, position = position_dodge(width = 0.9)) +
  # duration文本
  geom_text(data = textdf, 
            aes(x = id, y = duration + 0.3, label = type, group = group), 
            size = 2, position = position_dodge(width = 0.9)) +
  # ongoing箭头
  geom_segment(data = arrowdf, aes(x = x_pos, xend = x_pos, y = time1, yend = time2),
               arrow = arrow(length = unit(0.2, 'cm'), type = 'closed'), size = 1, 
               colour = 'red', show.legend = F) +
  # 主题与刻度设置
  xlab('') + ylab('Duration\n') +
  theme(plot.title = element_text(hjust = 0.5, face = 'bold'), plot.subtitle = element_text(hjust = 0.5),
        legend.title = element_blank(), legend.position = c(0.75, 0.7), 
        panel.background = element_rect(fill = 'white'), axis.ticks.y = element_blank(),
        axis.line.x = element_line(size = 0.5, colour = 'black'),
        axis.text.x = element_text(size = 10, face = 'bold', angle = 90),
        axis.text.y = element_text(size = 10, face = 'bold'), legend.text = element_text(size = 15),
        legend.spacing.y = unit(-0.2, 'cm'), legend.background = element_rect(color = 'white'),
        legend.key.size = unit(0.5, 'cm'), legend.key = element_blank()) +
  scale_y_continuous(expand = c(0.01,0), limits = c(-0.5, 12), breaks = seq(0, 12, by=1)) +
  scale_fill_manual(values = c('#333333', 'dark grey')) + # 替换未定义的charcoal色值
  scale_colour_manual(values = c('green', 'orange'), breaks = c('PD', '+B')) +
  scale_shape_manual(values = c(4, 3), breaks = c('PD', '+B')) +
  guides(fill = guide_legend(order = 2), shape = guide_legend(override.aes = list(size = 5))) 

plot1

关键说明 #

• 排序逻辑：通过提取group1的duration排序结果，将id转为因子实现X轴按要求排序
• 分组对齐：利用position_dodge(width = 0.9)（与柱状图的dodge宽度一致）让符号和文本精准对应到各自分组的柱子
• 位置调整：优化状态符号和文本的Y轴偏移量，避免遮挡且显示更美观

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