英文:
Merging specific x axis labels using ggarrange
问题
I am using ggarrange to make a combined plot, showing how different spatial distributions of white matter hyperintensity volume ("WMH") predict general cognitive function. For each spatial distribution of WMH, I show both the overall plot of the whole sample with a single trendline, and then replicate the same plot but with separate trendlines for each group included in the sample. I do this four times, so in total I end up with eight plots (see attached figure).
I am wondering if there is a way to merge the labels for each row, so for example, the first two graphs along the top row (row A), there would be a single centred axis label of "Total WMH +1 (mm3)" instead of two "Total WMH +1 (mm3)" labels, with this repeating for the other WMH volume distributions. I was able to do this with "ACE-III Scores" because it is the same dependent variable in all instances, unlike each WMH volume distribution.
Here is my code:
install.packages("ggplot2")
install.packages("ggpubr")
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(
<details>
<summary>英文:</summary>
I am using ggarrange to make a combined plot, showing how different spatial distributions of white matter hyperintensity volume ("WMH") predict general cognitive function. For each spatial distribution of WMH, I show both the overall plot of the whole sample with a single trendline, and then replicate the same plot but with separate trendlines for each group included in the sample. I do this four times, so in total I end up with eight plots (see attached figure). [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](https://i.stack.imgur.com/0T6lD.jpg)
I am wondering if there is a way to merge the labels for each row, so for example, the first two graphs along the top row (row A), there would be a single centred axis label of "Total WMH +1 (mm3)" instead of two "Total WMH +1 (mm3)" labels, with this repeating for the other WMH volume distributions. I was able to do this with "ACE-III Scores" because it is the same dependent variable in all instances, unlike each WMH volume distribution.
Here is my code:
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))
I tried using annotate_figure in a similar way to how I created the ACE-III scores y-axis label, but shortly realised afterwards that it was not going to be an appropriate solution as not only are each of these WMH Volumes unable to be summarised under one x-axis label, but I also need the placement of these labels to be placed in the centre of each row, underneath the respective graphs whereas I think annotate_figure works only in terms of coarse directions ("left", "right", "top", "bottom").
Thank you for reading :)
</details>
# 答案1
**得分**: 0
我认为这可以通过分面而不是`ggarrange`来完成。这确实需要"爆炸"（将数据扩展到你有多少个模型），但我不认为这会成为问题。
我将通过一个类似的数据集（3个`y`值）从简单到分面的单个模型到多个模型的步骤来解释。
数据：
```r
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）。
在您的情况下，我建议只选择您需要的x/y变量并删除任何其他变量；如果不这样做，要么pivot_longer会抱怨不同的类别（如果不是全部是numeric），要么它们将出现为明显的y变量（这不是您打算创建的图）。
我应该注意，默认情况下，使用facet_grid的行和列的x和y轴将在所有图块中相同；这可以使用scales="free"（或scales="free_x"或`scales="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(..)的替代方法，您可以
英文:
I think this can be done with faceting instead of ggarrange. This does require "exploding" (expanding the data by as many models as you have), but I don't think it'll be an issue.
I'll explain by walking through a similar dataset (3 y values) from simple to faceted-one-model to faceted-multiple-models.
Data:
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
For all examples below, I'm using tidyr::pivot_longer, though it can trivially be adapted to reshape2::melt or data.table::melt depending on your preferences.
Simple
ggplot(dat, aes(x, y1)) +
geom_point() +
geom_smooth(method = "loess", formula = y ~ x)
(Notice that the formula is still y ~ x regardless of the actual column names applied to the aesthetics.)
Multiple y variables, one smoothing models
pivot_longer(dat, -x) %>%
ggplot(aes(x, value)) +
geom_point() +
geom_smooth(method = "loess", formula = y ~ x) +
facet_grid(~ name)
Notice that we now have all three variables (my y1, y2, and y3, projecting to your tWMH_1, jWMH_1, and pWMH_1) with one smoothing model.
In your case, I suggest selecting only the x/y variables you need and removing any other variables; if you don't, either pivot_longer will complain about different classes (if not all numeric), or they will appear as apparent y variables (which is not the plot you're intending to create).
I should note that the default behavior with facet_grid is that the x and y axes will be the same across all panes; this can be relaxed using scales="free" (or "free_x" or "free_y"), but one purpose of this question (I believe) is to normalize the axes, so we'll keep them scaled to the same range.
Multiple y variables, multiple models
For this, we will need to repeat each data for each model. The actual names of the models are used in the facet strips/labels, so make them whatever you want. (crossing is also from tidyr, same as pivot_longer. There are non-dplyr methods for this as well, if needed.)
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
Now we're going to pivot (changing from -x to -c(x, model)), and update the faceting. For each type of model, we're going to subset the data that ggplot is using internally, so that each geom_smooth is only used on the model value we want it to; we use a ~-style (rlang) data argument so that it dynamically subsets the current data.
(I use dplyr::filter below; if you are not using dplyr, you can replace it perfectly with 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)
Wrapup
In this faceting example, I have 3x3; in yours, you have 4 variables and 2 smoothing methods to show for each. As an alternative to facet_grid(..), you can instead use facet_wrap(~ name + model, nrow = 2). The order of ~ name + model changes how the facet strips are structured. There are extension packages for ggplot2 that offer slightly nuanced ways to vary this faceting, such as @teunbrand's ggh4x and its nested facets.
通过集体智慧和协作来改善编程学习和解决问题的方式。致力于成为全球开发者共同参与的知识库，让每个人都能够通过互相帮助和分享经验来进步。
评论