使用ggarrange合并特定的x轴标签

wb1gzix0  于 2023-02-17  发布在  其他
关注(0)|答案(1)|浏览(175)

我用ggarrange做了一个组合图，显示了白色高信号体积的不同空间分布（“WMH”）预测一般认知功能。对于WMH的每个空间分布，我用单个趋势线示出整个样本的总体图，然后重复相同的图，但对样本中包括的每个组具有单独的趋势线。我这样做四次，因此，我总共得到了8个地块（见附图）。How the current figure looks with eight plots, each row shows the same WMH distribution predicting ACE-III score, just displayed in a different way
我想知道是否有一种方法可以合并每行的标签，例如，沿着顶行的前两个图表（行A），则将有一个“总WMH +1”的单中心轴标签（mm 3）”而不是2“总WMH +1（mm 3）”标签，对其他WMH体积分布重复此操作。我可以使用“ACE-III评分”进行此操作因为它在所有情况下都是相同的因变量，与每个WMH体积分布不同。
下面是我的代码：

install.packages("ggplot2")
#> Installing package into 'C:/Users/camhe/AppData/Local/R/win-library/4.2'
#> (as 'lib' is unspecified)
#> package 'ggplot2' successfully unpacked and MD5 sums checked
#> 
#> The downloaded binary packages are in
#>  C:\Users\camhe\AppData\Local\Temp\RtmpgZbHG6\downloaded_packages
install.packages("ggpubr")
#> Installing package into 'C:/Users/camhe/AppData/Local/R/win-library/4.2'
#> (as 'lib' is unspecified)
#> package 'ggpubr' successfully unpacked and MD5 sums checked
#> 
#> The downloaded binary packages are in
#>  C:\Users\camhe\AppData\Local\Temp\RtmpgZbHG6\downloaded_packages
library(ggplot2)
library(ggpubr)

#For Total WMH +1 (mm3)
tWMH_ACE_plot_whole <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(tWMH_1, ACE)) + 
  geom_point(size=2.5, alpha = 0.5, aes(col=Classification)) +
  geom_smooth(method="lm", colour = "black", level = 0.95, alpha = 0.25) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Total WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

tWMH_ACE_plot_bygroup <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(tWMH_1, ACE, col=Classification)) + 
  geom_point(size=2.5) +
  geom_smooth(method="lm", se = F) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Total WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

#For Juxtaventricular WMH +1 (mm3)
jWMH_ACE_plot_whole <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(jWMH_1, ACE)) + 
  geom_point(size=2.5, alpha = 0.5, aes(col=Classification)) +
  geom_smooth(method="lm", colour = "black", level = 0.95, alpha = 0.25) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Juxtaventricular WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

jWMH_ACE_plot_bygroup <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(jWMH_1, ACE, col=Classification)) + 
  geom_point(size=2.5) + 
  geom_smooth(method="lm", se = F) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Juxtaventricular WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

#For Periventricular WMH +1 (mm3)
pWMH_ACE_plot_whole <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(pWMH_1, ACE)) + 
  geom_point(size=2.5, alpha = 0.5, aes(col=Classification)) +
  geom_smooth(method="lm", colour = "black", level = 0.95, alpha = 0.25) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Periventricular WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

pWMH_ACE_plot_bygroup <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(pWMH_1, ACE, col=Classification)) + 
  geom_point(size=2.5) +
  geom_smooth(method="lm", se = F) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Periventricular WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

#For Deep WMH +1 (mm3)
dWMH_ACE_plot_whole <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(dWMH_1, ACE)) + 
  geom_point(size=2.5, alpha = 0.5, aes(col=Classification)) +
  geom_smooth(method="lm", colour = "black", level = 0.95, alpha = 0.25) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Deep WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

dWMH_ACE_plot_bygroup <- ggplot(newsubj_twmh_megattracks_and_honours_dropna, aes(dWMH_1, ACE, col=Classification)) + 
  geom_point(size=2.5) +
  geom_smooth(method="lm", se = F) + 
  scale_x_continuous(trans='log10') + 
  labs(y = "", x = "Deep WMH + 1 (mm3)") + 
  theme(legend.text = element_text(size = 14), legend.title = element_text(size = 16), axis.title = element_text(size = 14), axis.text = element_text(size = 12)) + 
  theme(legend.key = element_rect(fill = NA)) + 
  guides(colour = guide_legend(override.aes = list(alpha = 1)))

#Combining all these graphs into one
all_ACE_combined <- ggarrange(
  tWMH_ACE_plot_whole, tWMH_ACE_plot_bygroup, jWMH_ACE_plot_whole, 
  jWMH_ACE_plot_bygroup, pWMH_ACE_plot_whole, pWMH_ACE_plot_bygroup, 
  dWMH_ACE_plot_whole, dWMH_ACE_plot_bygroup, nrow = 4, ncol = 2, 
  common.legend = T, legend = "right",
  labels=c("A", "", "B", "", "C", "", "D", ""))

all_ACE_combined <- annotate_figure(all_ACE_combined,
                left = text_grob("ACE-III Scores", size = 14, rot = 90))

我尝试以类似于创建ACE-III评分y轴标签的方式使用annotate_figure，但不久之后意识到这不是一个合适的解决方案，因为不仅这些WMH卷中的每一个无法汇总在一个x轴标签下，而且我还需要将这些标签放置在每行的中心。而我认为annotate_figure仅在粗略方向（“左”、“右”、“上”、“下”）方面起作用。
感谢您的阅读：）

r

1条答案

按热度按时间
zzwlnbp8

zzwlnbp81#

我认为这可以通过刻面而不是ggarrange来实现，这需要"爆炸"（通过尽可能多的模型来扩展数据），但我不认为这会是一个问题。
我将通过一个类似的数据集（3个y值）进行解释，从简单到面单模型再到面多模型。
数据：

set.seed(42)
dat <- data.frame(x = 1:10, y1 = runif(10), y2 = runif(10), y3 = runif(10))
dat
#     x     y1     y2      y3
# 1   1 0.9148 0.4577 0.90403
# 2   2 0.9371 0.7191 0.13871
# 3   3 0.2861 0.9347 0.98889
# 4   4 0.8304 0.2554 0.94667
# 5   5 0.6417 0.4623 0.08244
# 6   6 0.5191 0.9400 0.51421
# 7   7 0.7366 0.9782 0.39020
# 8   8 0.1347 0.1175 0.90574
# 9   9 0.6570 0.4750 0.44697
# 10 10 0.7051 0.5603 0.83600

对于下面的所有示例，我使用的是tidyr::pivot_longer，尽管根据您的喜好，它可以简单地适应reshape2::melt或data.table::melt。

简单

ggplot(dat, aes(x, y1)) +
  geom_point() +
  geom_smooth(method = "loess", formula = y ~ x)

（请注意，公式仍为y ~ x，与应用于aes理论的实际列名无关。）

多个y变量，一个平滑模型

pivot_longer(dat, -x) %>%
  ggplot(aes(x, value)) +
  geom_point() +
  geom_smooth(method = "loess", formula = y ~ x) +
  facet_grid(~ name)

请注意，我们现在有了所有三个变量（我的y1、y2和y3，投影到您的tWMH_1、jWMH_1和pWMH_1），它们使用一个平滑模型。
在您的情况下，我建议select只使用您需要的x/y变量，并删除任何其他变量;如果不这样做，pivot_longer将抱怨不同的类（如果不是所有numeric），或者它们将显示为明显的y变量（这不是您打算创建的图）。
应该注意，facet_grid的默认行为是x和y轴在所有窗格中都是相同的;使用scales="free"（或"free_x"或"free_y"）可以放松这一点，但我认为这个问题的一个目的是归一化轴，因此我们将它们保持在相同的范围内。

多个y变量，多个型号

为此，我们需要为每个模型重复每个数据。模型的实际名称用于刻面条带/标签中，因此可以随意设置。（crossing也来自tidyr，与pivot_longer相同。如果需要，也可以使用非dplyr方法。）

print(crossing(dat, model = c("loess", "lm 95%", "lm 99%")), n = 5)
# # A tibble: 30 × 5
#       x    y1    y2    y3 model 
#   <int> <dbl> <dbl> <dbl> <chr> 
# 1     1 0.915 0.458 0.904 lm 95%
# 2     1 0.915 0.458 0.904 lm 99%
# 3     1 0.915 0.458 0.904 loess 
# 4     2 0.937 0.719 0.139 lm 95%
# 5     2 0.937 0.719 0.139 lm 99%
# # … with 25 more rows
# # ℹ Use `print(n = ...)` to see more rows

现在我们要进行透视（从-x更改为-c(x, model)），并更新面，对于每种类型的模型，我们要将ggplot内部使用的数据进行子集化，这样每个geom_smooth只用于我们希望使用的model值;我们使用~样式（rlang）数据参数，以便它动态地将当前数据分成子集。
（我在下面使用dplyr::filter;如果您不使用dplyr，则可以将其完美地替换为subset。）

crossing(dat, model = c("loess", "lm 95%", "lm 99%")) %>%
  pivot_longer(-c(x, model)) %>%
  ggplot(aes(x, value)) +
  geom_point() +
  geom_smooth(data = ~ filter(., model == "loess"),
              method = "loess", formula = y ~ x) +
  geom_smooth(data = ~ filter(., model == "lm 99%"),
              method = "lm", formula = y ~ x, level = 0.99) +
  geom_smooth(data = ~ filter(., model == "lm 95%"),
              method = "lm", formula = y ~ x, level = 0.95) +
  facet_grid(model ~ name)

总结

在这个刻面的例子中，我有3x3;在您的示例中，您有4个变量和2种平滑方法。作为facet_grid(..)的替代方法，您可以使用facet_wrap(~ name + model, nrow = 2)。~ name + model的顺序会改变刻面条带的结构。ggplot2的扩展包提供了一些细微差别的方式来改变刻面，例如@teunbrand的ggh4x及其嵌套刻面。

赞(0）分享  回复(0）举报  2023-02-17
我来回答

相关问题

    查看更多

    热门标签

    更多
    JavaquerypythonNode开发语言requestUtil数据库Table后端算法LoggerMessageElementParser

    最新问答

    更多
    • 蜀ICP备2022004421号-2 NULL123 https://www.null123.com © All rights reserved
    • 本站内容来源互联网,如果侵犯您的权益请联系我们删除, 联系方式：448109455@qq.com