R语言 向2个拼接图添加单个组合x轴标题

ycggw6v2  于 2022-12-25  发布在  其他
关注(0)|答案(3)|浏览(238)

我已经使用patchwork软件包组合了两个单独的ggplot2图。如何将单个组合的x轴标题(例如“SD单位差异”)添加到下面的拼接图中?

dat_F <- structure(list(
  term = c("ExpA", "ExpA", "ExpB", "ExpB"), 
  estimate = c(-3.802316239, -5.885048428, -3.678601513, -4.103813546), 
  lci = c(-4.42722285, -6.476932582, -4.332540471, -4.751382827), 
  uci = c(-3.177409628, -5.293164273, -3.024662556, -3.456244265), 
  out = c("Out1", "Out2", "Out1", "Out2")), 
  class = "data.frame", row.names = c(NA, -4L))

    dat_M <- structure(list(
  term = c("ExpA", "ExpA", "ExpB", "ExpB"), 
  estimate = c(-1.134138758, -2.232236452, -0.935606149, -1.497766819), 
  lci = c(-1.841890314, -2.894980123, -1.662179615, -2.180915403), 
  uci = c(-0.426387201, -1.569492781, -0.209032682, -0.814618236), 
  out = c("Out3", "Out4", "Out3", "Out4")), 
  class = "data.frame", row.names = c(NA, -4L))

library(tidyverse)
library(patchwork)
library(RColorBrewer)

(plot_F <- ggplot(data = dat_F, aes(
  x = term, y = estimate, ymin = lci, ymax = uci)) + 
    theme_classic() + geom_pointrange(size = 0.3, aes(col = term)) + coord_flip() +
    ggtitle("a. Females") + geom_hline(yintercept = 0, lty = 1, size = 0.1, col = "red") + 
    facet_wrap(~ out, ncol = 1) + scale_color_brewer(palette = "Set2") +
    scale_y_continuous(limits = c(-7, 0.5), breaks=c(-6, -4, -2, 0)) + 
    ylab("")  + theme(axis.title.y = element_blank(), axis.ticks.y = element_blank(), 
      strip.background = element_blank(), axis.text.y = element_blank(), 
      legend.title = element_blank(), legend.position  = "bottom") +
    guides(colour = guide_legend(override.aes = list(size=0.8)))) 

(plot_M <- ggplot(data = dat_M, aes(
  x = term, y = estimate, ymin = lci, ymax = uci)) + 
    theme_classic() + geom_pointrange(size = 0.3, aes(col = term)) + coord_flip() +
    ggtitle("b. Males") + geom_hline(yintercept = 0, lty = 1, size = 0.1, col = "red") + 
    facet_wrap(~ out, ncol = 1) + scale_color_brewer(palette = "Set2") +
    scale_y_continuous(limits = c(-7, 0.5), breaks=c(-6, -4, -2, 0)) + 
    ylab("")  + theme(axis.title.y = element_blank(), axis.ticks.y = element_blank(), 
                      strip.background = element_blank(), axis.text.y = element_blank(), 
                      legend.title = element_blank(), legend.position  = "bottom") +
    guides(colour = guide_legend(override.aes = list(size=0.8)))) 

(combined_plot <- (plot_F + plot_M) + 
  plot_layout(guides = "collect") & theme(
    legend.position = 'bottom', 
    legend.direction = "horizontal",
    text = element_text(size = 8)))

wfsdck30

wfsdck301#

通过在patchwork调用后添加textGrob,可以根据需要添加文本。

(combined_plot <- (plot_F + plot_M) + 
    plot_layout(guides = "collect") & theme(
      legend.position = 'bottom', 
      legend.direction = "horizontal",
      text = element_text(size = 8)))

grid::grid.draw(grid::textGrob('diffence in SD units', x =.5, y=0.15))

jm2pwxwz

jm2pwxwz2#

TBMK patchwork没有“收集”轴标题或只有一个标题的选项。但有一个选项是通过第三个图添加组合轴标题:

library(tidyverse)
library(patchwork)
library(RColorBrewer)

plot_fun <- function(.data) {
  ggplot(data = .data, aes(
    x = estimate, y = term, xmin = lci, xmax = uci
  )) +
    theme_classic() +
    geom_pointrange(size = 0.3, aes(col = term)) +
    ggtitle("a. Females") +
    geom_vline(xintercept = 0, lty = 1, size = 0.1, col = "red") +
    facet_wrap(~out, ncol = 1) +
    scale_color_brewer(palette = "Set2") +
    scale_x_continuous(limits = c(-7, 0.5), breaks = c(-6, -4, -2, 0)) +
    ylab("") +
    theme(
      axis.title.y = element_blank(), axis.ticks.y = element_blank(),
      strip.background = element_blank(), axis.text.y = element_blank(),
      legend.title = element_blank(), legend.position = "bottom"
    ) +
    guides(colour = guide_legend(override.aes = list(size = 0.8))) +
    labs(x = NULL)
}
plot_F <- plot_fun(dat_F)
plot_M <- plot_fun(dat_M)

axis_title <- ggplot(data.frame(x = c(0, 1)), aes(x = x)) + geom_blank() +
  theme_void() + 
  theme(axis.title.x = element_text()) + 
  labs(x = "difference in SD units")

(combined_plot <- ((plot_F + plot_M)  / axis_title) +
  plot_layout(guides = "collect", heights = c(40, 1)) & 
    theme(
      legend.position = "bottom",
      legend.direction = "horizontal",
      text = element_text(size = 8)
    )
)

z2acfund

z2acfund3#

除了patchwork,你可以通过合并数据集然后使用facet_grid来完成这个任务。我不得不为每个性别添加一个对应于垂直面位置的新变量来完成这个任务,但我认为结果更好。

dat_F <- structure(list(
  term = c("ExpA", "ExpA", "ExpB", "ExpB"), 
  estimate = c(-3.802316239, -5.885048428, -3.678601513, -4.103813546), 
  lci = c(-4.42722285, -6.476932582, -4.332540471, -4.751382827), 
  uci = c(-3.177409628, -5.293164273, -3.024662556, -3.456244265), 
  out = c("Out1", "Out2", "Out1", "Out2"), 
  out2 = c("1", "2", "1", "2")), 
class = "data.frame", row.names = c(NA, -4L))

dat_M <- structure(list(
  term = c("ExpA", "ExpA", "ExpB", "ExpB"), 
  estimate = c(-1.134138758, -2.232236452, -0.935606149, -1.497766819), 
  lci = c(-1.841890314, -2.894980123, -1.662179615, -2.180915403), 
  uci = c(-0.426387201, -1.569492781, -0.209032682, -0.814618236), 
  out = c("Out3", "Out4", "Out3", "Out4"), 
  out2 = c("1", "2", "1", "2")), 
class = "data.frame", row.names = c(NA, -4L))

ggplot(rbindlist(list("Males"=dat_M,"Females"=dat_F), idcol="sex"), aes(
      x = term, y = estimate, ymin = lci, ymax = uci)) + 
     theme_classic() + 
     geom_pointrange(size = 0.3, aes(col = term)) + coord_flip() +
     geom_hline(yintercept = 0, lty = 1, size = 0.1, col = "red") + 
     facet_grid(out2~sex) + scale_color_brewer(palette = "Set2") +
     scale_y_continuous(limits = c(-7, 0.5), breaks=c(-6, -4, -2, 0)) + 
     ylab("")  + theme(axis.title.y = element_blank(), 
                       #axis.ticks.y = element_blank(),
                       strip.text.y = element_blank(),
                       strip.background = element_blank(), 
                       #axis.text.y = element_blank(), 
                       legend.title = element_blank(), 
                       legend.position  = "bottom") +
     guides(colour = guide_legend(override.aes = list(size=0.8))) +
     labs(y="Difference in SD units")
     geom_text(aes(label=out, y=-6, x=2.2))

相关问题