如何解决ggplot2绘图中图例在图表下方不对齐的问题

问题背景 #

这是此前技术问题的后续，该问题已由社区给出优雅解答。本次使用与之前相同的数据集，因set.seed和自动定义点形状的部分存在问题，对代码进行了微调，但运行后生成的图表底部图例出现错位，需要实现图例与图表下方的对齐。

数据集 #

topclones <- structure(list(CTaa_beta = c("CASSEGTSGGASTQYF", "CASSEGTSGGASTQYF", 
"CSVEDPSSGSYEQYF", "CASSVAGPNTEAFF", "CSARDPETYEQYF", "CASSVAGPNTEAFF", 
"CASSLGGLGTSTDTQYF", "CASSLRQGPSYEQYF", "CASSLGEYYGYTF", "CASSFGYTGELFF", 
"CASSVGNRGGTDTQYF", "CASSELAGGQETQYF", "CSVPAGYTDTQYF", "CASSPGTAVQGYTF", 
"CASSNWGGRGHTDTQYF", "CASRDSDGLAYQPQHF", "CSVPGTSTSGEQFF", "CASKPGTTSNQPQHF", 
"CASSYPTSGANVLTF", "CSASTGADYNEQFF", "CSARVPTSGDYNEQFF", "CASSYPTSGANVLTF", 
"CASRPEQGGPYEQYF", "CSARGGKENSPLHF", "CSVAGTGVYNEQFF", "CSVVPGGQGGYEQYF", 
"CASSLEGRERYEQFF", "CASSVGLFSTDTQYF", "CASSLRGGPYNEQFF", "CASSLLAGGNNEQFF", 
"CASSPLQGPSQPQHF", "CATSGRGDEVGELFF", "CSARAGESGRAMEQFF", "CASSLRQGPSYEQYF", 
"CASTPAVRDGNYEQYF", "CASSPSTGYNEQFF", "CASSSGGLDEQYF", "CASSQDRGTGANVLTF", 
"CASSFGTENTGELFF", "CATSGRGDEVGELFF", "CAWSVQSGGHEQYF", "CASSPGTAVQGYTF", 
"CSARGGKENSPLHF", "CASSDSGGAYNEQFF", "CASSQDSGSGANVLTF", "CASSAGLAGGYEQYF", 
"CASSSPGTTNEKLFF", "CASSLRGGPYNEQFF", "CASSQAKGGGETQYF"), Group = structure(c(6L, 
7L, 3L, 4L, 1L, 3L, 1L, 4L, 1L, 1L, 4L, 2L, 1L, 2L, 2L, 6L, 2L, 
4L, 7L, 2L, 7L, 6L, 7L, 7L, 4L, 4L, 4L, 7L, 6L, 4L, 7L, 6L, 1L, 
3L, 4L, 2L, 4L, 1L, 7L, 7L, 2L, 3L, 6L, 2L, 6L, 4L, 4L, 7L, 7L
), levels = c("HC PBMC", "axSpA PBMC", "axSpA SFMC", "InEx", 
"PD-1+ TIGIT+", "ReA PBMC", "ReA SFMC"), class = "factor"), n = c(441L, 
292L, 345L, 303L, 268L, 264L, 242L, 200L, 218L, 211L, 163L, 242L, 
166L, 225L, 223L, 59L, 209L, 125L, 53L, 177L, 48L, 44L, 46L, 
45L, 99L, 96L, 94L, 41L, 39L, 89L, 40L, 38L, 97L, 97L, 85L, 128L, 
80L, 88L, 36L, 35L, 117L, 84L, 30L, 106L, 29L, 67L, 66L, 29L, 
29L), Total_n_per_group = c(2770L, 2899L, 7226L, 6400L, 7081L, 
7226L, 7081L, 6400L, 7081L, 7081L, 6400L, 9999L, 7081L, 9999L, 
9999L, 2770L, 9999L, 6400L, 2899L, 9999L, 2899L, 2770L, 2899L, 
2899L, 6400L, 6400L, 6400L, 2899L, 2770L, 6400L, 2899L, 2770L, 
7081L, 7226L, 6400L, 9999L, 6400L, 7081L, 2899L, 2899L, 9999L, 
7226L, 2770L, 9999L, 2770L, 6400L, 6400L, 2899L, 2899L), Percent = c(15.92, 
10.07, 4.77, 4.73, 3.78, 3.65, 3.42, 3.12, 3.08, 2.98, 2.55, 
2.42, 2.34, 2.25, 2.23, 2.13, 2.09, 1.95, 1.83, 1.77, 1.66, 1.59, 
1.59, 1.55, 1.55, 1.5, 1.47, 1.41, 1.41, 1.39, 1.38, 1.37, 1.37, 
1.34, 1.33, 1.28, 1.25, 1.24, 1.24, 1.21, 1.17, 1.16, 1.08, 1.06, 
1.05, 1.05, 1.03, 1, 1)), row.names = c(NA, -49L), class = c("tbl_df", 
"tbl", "data.frame"))

调整后的代码 #

library(dplyr)
library(scales)
library(colorspace)
library(ggplot2)
library(patchwork)

# Remove unused factor level (PD1+TIGIT+ in Group)
topclones$Group <- droplevels(topclones$Group)

# Create tibble defining unique point shapes for each duplicated value in CTaa_beta
styles <- topclones %>%
  filter(n() > 1, .by = CTaa_beta) %>%
  select(CTaa_beta, Group) %>%
  mutate(point_shape = setNames(sample(0:20, length(unique(CTaa_beta))), unique(CTaa_beta))[CTaa_beta])

# Sort topclones, join styles to topclones while matching Group to Group and CTaa_beta to CTaa_beta
topclones <- topclones |>
  arrange(Group, CTaa_beta) |>
  left_join(styles, by = join_by(Group, CTaa_beta))

# Generate min and max colour hues for each Group based on hue_pal()
colour1 <- darken(hue_pal()(length(unique(topclones$Group))), 0.5)
colour2 <- lighten(hue_pal()(length(unique(topclones$Group))), 0.5)

# Initialise colours column, loop through groups, assign colourramps
topclones$colours <- NA
ct <- 0
for (i in unique(topclones$Group)) {
  
  ct <- ct + 1
  n <- length(unique(topclones$CTaa_beta[topclones$Group == i]))
  groups <- unique(topclones$CTaa_beta[topclones$Group == i])
  group_colours <- setNames(colorRampPalette(c(colour1[ct], colour2[ct]))(n), groups)
  topclones$colours[topclones$Group == i] <- group_colours[topclones$CTaa_beta[topclones$Group == i]]
  
}

# Generate list of plots for each Group
p_tmp <- lapply(unique(topclones$Group), \(x) {
  
  tmp <- topclones |> filter(Group == x)
  
  ggplot(tmp) +
    geom_col(aes(CTaa_beta, Percent, fill = CTaa_beta),
             width = 1) +
    geom_point(aes(CTaa_beta, 0.25, shape = CTaa_beta),
               size = 2,
               stroke = 1,
               colour = "white") +
    labs(x = x) +
    scale_fill_manual(name = "", values = tmp$colours) +
    scale_shape_manual(name = "", values = tmp$point_shape)
  
})

# Get rounded up max summed Percent for y-axis (in case of > 1 CTaa_beta value per Group)
max_y <- ceiling(max(aggregate(Percent ~ Group + CTaa_beta,
                               data = topclones,
                               FUN = sum)$Percent))

# Get vector of Group lengths for plot widths
pw <- topclones |>
  summarise(n = n_distinct(CTaa_beta), .by = Group) |>
  pull(n)

# Plot
p <- wrap_plots(p_tmp,
                nrow = 1,
                axes = "collect_y") +
  plot_layout(widths = unit(pw, rep("cm", length(pw))),
              heights = unit(rep(16, length(pw)), rep("cm", length(pw)))) &
  geom_text(aes(CTaa_beta, Percent, label = Percent),
            vjust = -.5,
            position = position_dodge(1)) &
  scale_y_continuous(limits = c(0, max_y),
                     breaks = seq(0, max_y, length.out = 5)) &
  guides(fill = guide_legend(nrow = 10),
         shape = guide_legend(override.aes = list(size = 1, stroke = 0.75))) &
  ylab("Frequency of CTaa_beta (% total cells per group)") &
  coord_cartesian(expand = FALSE,
                  clip = "off") &
  theme_classic() &
  theme(axis.text = element_text(size = 18),
        axis.title = element_text(size = 18),
        axis.title.x = element_text(vjust = -1),
        axis.ticks.x = element_blank(),
        legend.text = element_text(size = 10),
        legend.position = "bottom",
        legend.justification = c(0.5, 0.5),
        legend.key.spacing.y = unit(0, "mm"),
        axis.text.x = element_blank())

suppressWarnings(
  ggsave("/Users/zoyaqaiyum/Downloads/gradient_colours_by_group_no_thatching.jpg",
         p,
         width = 30, 
         height = 12,
         dpi = 150)
  )

解决方案 #

图例错位的核心原因是patchwork默认的图例收集逻辑未与主图宽度对齐，通过以下两处修改可解决问题：

1. 子图隐藏独立图例，由patchwork统一收集 #

修改p_tmp生成代码，给每个子图添加theme(legend.position = "none")，避免子图单独渲染图例：

# Generate list of plots for each Group
p_tmp <- lapply(unique(topclones$Group), \(x) {
  
  tmp <- topclones |> filter(Group == x)
  
  ggplot(tmp) +
    geom_col(aes(CTaa_beta, Percent, fill = CTaa_beta),
             width = 1) +
    geom_point(aes(CTaa_beta, 0.25, shape = CTaa_beta),
               size = 2,
               stroke = 1,
               colour = "white") +
    labs(x = x) +
    scale_fill_manual(name = "", values = tmp$colours) +
    scale_shape_manual(name = "", values = tmp$point_shape) +
    theme(legend.position = "none")  # 子图不显示图例
  
})

2. 优化全局图例布局与对齐设置 #

修改组合图部分的wrap_plots和theme参数，统一收集图例并设置居中对齐：

# 修改后的Plot部分
p <- wrap_plots(p_tmp,
                nrow = 1,
                axes = "collect_y",
                guides = "collect") +  # 统一收集所有子图图例
  plot_layout(widths = unit(pw, rep("cm", length(pw))),
              heights = unit(rep(16, length(pw)), rep("cm", length(pw)))) &
  geom_text(aes(CTaa_beta, Percent, label = Percent),
            vjust = -.5,
            position = position_dodge(1)) &
  scale_y_continuous(limits = c(0, max_y),
                     breaks = seq(0, max_y, length.out = 5)) &
  guides(
    fill = guide_legend(nrow = 10, byrow = TRUE),  # 按行排列图例项
    shape = guide_legend(override.aes = list(size = 1, stroke = 0.75), nrow = 10, byrow = TRUE),
    merge = TRUE  # 合并fill与shape图例
  ) &
  ylab("Frequency of CTaa_beta (% total cells per group)") &
  coord_cartesian(expand = FALSE,
                  clip = "off") &
  theme_classic() &
  theme(axis.text = element_text(size = 18),
        axis.title = element_text(size = 18),
        axis.title.x = element_text(vjust = -1),
        axis.ticks.x = element_blank(),
        legend.text = element_text(size = 10),
        legend.position = "bottom",
        legend.justification = "center",  # 图例内容居中
        legend.box.just = "center",  # 图例框整体居中
        legend.key.spacing.y = unit(0, "mm"),
        legend.margin = margin(t = 10, b = 0, unit = "mm"),  # 调整图例上下边距
        plot.margin = margin(b = 30, unit = "mm"),  # 主图底部留足图例空间
        axis.text.x = element_blank())

修改后重新运行代码，图例将自动居中对齐在图表正下方，解决错位问题。

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