组合 ggplots 并创建一个组合图例

Question

我尝试使用各种不同的方法来为我的 4 个 ggplots 创建一个组合图例，但是，它要么导致其中一个图与另一个图相比被压扁，因为图例位于该绘图区域内，要么它出错。

这是一个可重复的数据集，可用于我的图表并为其编写代码：

var=c("White", "Black", "Asian","White", "Black", "Asian","White", "Black", "Asian","White", "Black", "Asian","White", "Black", "Asian","White", "Black", "Asian")
gender=c("Men","Women","Men","Women","Men","Women","Men","Women","Men","Women","Men","Women","Men","Women","Men","Women","Men","Women")
p=c(25, 35, 45, 26, 57, 43,35, 45, 43, 36, 27, 53,23, 55, 25, 25, 37, 23)
n=c(50, 100, 96, 57, 56, 54,50, 90, 96, 57, 56, 54,60, 110, 66, 37, 56, 54)
year=c(2019,2019,2019,2019,2019,2019, 2020,2020,2020,2020,2020,2020,2021,2021,2021,2021,2021,2021)

df=data.frame(year,var,gender,n,p)
df$var=factor(df$var, levels=c("Black","Asian","White"))
df$year=factor(df$year, levels=c(2019, 2020, 2021))

# Create graphs for men
men1=ggplot(data=df %>% filter(gender=="Men"), aes(x=year,y=n,group=var, colour=var))+
  geom_line() +
  scale_y_continuous(expand = expansion(mult = c(0, .06)), limits = c(0, 150)) +
  theme(text=element_text(size=12),
        axis.text = element_text(size=12),
        axis.title = element_text(size=12, face="bold"),
        legend.position="none",
        axis.line.y=element_blank(),
        plot.title.position="plot",
        plot.subtitle=element_text(size=12, face="bold", margin = margin(b = 2)))+
  labs(x = NULL, y = NULL, subtitle = "Number diagnosed")

men2=ggplot(data=df %>% filter(gender=="Men"), aes(x=year,y=p,group=var, colour=var))+
  geom_line() +
  scale_y_continuous(expand = expansion(mult = c(0, .06)), limits = c(0, 100)) +
  theme(text=element_text(size=12),
        axis.text = element_text(size=12),
        axis.title = element_text(size=12, face="bold"),
        legend.position="none",
        axis.line.y=element_blank(),
        plot.title.position="plot",
        plot.subtitle=element_text(size=12, face="bold", margin = margin(b = 2)))+
  labs(x = NULL, y = NULL, subtitle = "Proportion diagnosed")

# Combine graphs
men_combined=ggarrange(men1, men2,
                 nrow=1, ncol=2
)

# Add title to figure
men_combined=annotate_figure(men_combined, 
                       top = text_grob("\nMen",
                                       color = "black", face = "bold", size = 25))

# Create graphs for women
women1=ggplot(data=df %>% filter(gender=="Women"), aes(x=year,y=n,group=var, colour=var))+
  geom_line() +
  scale_y_continuous(expand = expansion(mult = c(0, .06)), limits = c(0, 150)) +
  theme(text=element_text(size=12),
        axis.text = element_text(size=12),
        axis.title = element_text(size=12, face="bold"),
        legend.position="none",
        axis.line.y=element_blank(),
        plot.title.position="plot",
        plot.subtitle=element_text(size=12, face="bold", margin = margin(b = 2)))+
  labs(x = NULL, y = NULL, subtitle = "Number diagnosed")

women2=ggplot(data=df %>% filter(gender=="Women"), aes(x=year,y=p,group=var, colour=var))+
  geom_line() +
  scale_y_continuous(expand = expansion(mult = c(0, .06)), limits = c(0, 100)) +
  theme(text=element_text(size=12),
        axis.text = element_text(size=12),
        axis.title = element_text(size=12, face="bold"),
        legend.position="none",
        axis.line.y=element_blank(),
        plot.title.position="plot",
        plot.subtitle=element_text(size=12, face="bold", margin = margin(b = 2)))+
  labs(x = NULL, y = NULL, subtitle = "Proportion diagnosed")

# Combine graphs
women_combined=ggarrange(women1, women2,
                       nrow=1, ncol=2
)

# Add title to figure
women_combined=annotate_figure(women_combined, 
                             top = text_grob("\nWomen",
                                             color = "black", face = "bold", size = 25))

# Combine all together
    all_plots=ggarrange(men_combined, women_combined,
                       nrow=2, ncol=1)`

我尝试使用以下内容来提供帮助，并且我能够获得一个常见的图例，但是当我尝试使用 annotate_figure 时它不起作用，因为我需要在每个图例上方有一个标题来显示性别。 为组合 ggplots 添加通用图例

这是我使用的代码，当我添加“男性”和“女性”标题时，该代码不起作用：

grid_arrange_shared_legend <- function(..., nrow = 1, ncol = length(list(...)), position = c("bottom", "right")) {
    
    plots <- list(...)
    position <- match.arg(position)
    g <- ggplotGrob(plots[[1]] + theme(legend.position = position))$grobs
    legend <- g[[which(sapply(g, function(x) x$name) == "guide-box")]]
    lheight <- sum(legend$height)
    lwidth <- sum(legend$width)
    gl <- lapply(plots, function(x) x + theme(legend.position = "none"))
    gl <- c(gl, nrow = nrow, ncol = ncol)
    
    combined <- switch(position,
                       "bottom" = arrangeGrob(do.call(arrangeGrob, gl),
                                              legend,
                                              ncol = 1,
                                              heights = unit.c(unit(1, "npc") - lheight, lheight)),
                       "right" = arrangeGrob(do.call(arrangeGrob, gl),
                                             legend,
                                             ncol = 2,
                                             widths = unit.c(unit(1, "npc") - lwidth, lwidth)))
    grid.newpage()
    grid.draw(combined)
    
}

grid_arrange_shared_legend(men1, men2, women1, women2, nrow = 2, ncol = 2)

这就是代码的结果，这正是我想要的，但它需要有“男性”和“女性”标题：

请帮忙！！ :)

Answer 1

你可以像这样使用

patchwork::wrap_elements

library(patchwork)
library(dplyr)
library(ggplot2)



men1=ggplot(data=df %>% filter(gender=="Men"), aes(x=year,y=n,group=var, colour=var))+
  geom_line() +
  labs(x = NULL, y = NULL, subtitle = "Number diagnosed") +
  theme(legend.position = 'none')

men2=ggplot(data=df %>% filter(gender=="Men"), aes(x=year,y=p,group=var, colour=var))+
  geom_line() +
  labs(x = NULL, y = NULL, subtitle = "Proportion diagnosed") +
  theme(legend.position = 'none')

women1=ggplot(data=df %>% filter(gender=="Women"), aes(x=year,y=n,group=var, colour=var))+
  geom_line() +
  labs(x = NULL, y = NULL, subtitle = "Number diagnosed") +
  theme(legend.position = 'none')

women2=ggplot(data=df %>% filter(gender=="Women"), aes(x=year,y=p,group=var, colour=var))+
  geom_line() +
  labs(x = NULL, y = NULL, subtitle = "Proportion diagnosed")


men_plot = men1 + men2 + plot_annotation(subtitle = 'Men') 

women_plot = women1 + women2 + plot_annotation(subtitle = 'Women') + plot_layout(guides = 'collect') & theme(legend.position = 'bottom')


wrap_elements(men_plot)/ wrap_elements(women_plot)

^{创建于 2024 年 11 月 21 日，使用 reprex v2.1.1}