ggplot2 跨组中的嵌套构面
Nested facets in ggplot2 spanning groups
我遇到了一种情况，我想创建一个由三个分组变量分面的图。为此，我会简单地使用 facet_grid(f1 ~ f2 + f3)，但这里的问题是 f2 的标签是多余的，最好让它们跨越嵌套在 f2.[=13= 中的 f3 的各个方面。 ]
MWE：
library('tibble')
library('ggplot2')
df <- tribble(
~x, ~y, ~f1, ~f2, ~f3,
0.5, 0.5, "a", "a", "a",
0.5, 0.5, "b", "a", "a",
0.5, 0.5, "a", "b", "a",
0.5, 0.5, "b", "b", "a",
0.5, 0.5, "a", "a", "b",
0.5, 0.5, "b", "a", "b",
0.5, 0.5, "a", "b", "b",
0.5, 0.5, "b", "b", "b"
)
p <- ggplot(df, aes(x = x, y = y)) +
geom_point() +
facet_grid(f1 ~ f2 + f3)
同样，我希望合并 f2 的标签，这样它们就不会那么多余了。
编辑：这与其他问题的不同之处在于它询问如何使用现有分组来修改构面而不是添加新的构面。
答案在 grid 和 gtable 包中。情节中的所有内容都按特定顺序排列，如果您稍微挖掘一下，就可以找到所有内容的位置。
library('gtable')
library('grid')
library('magrittr') # for the %>% that I love so well
# First get the grob
z <- ggplotGrob(p)
此操作的最终目标是覆盖顶面标签，但诀窍在于这两个面都存在于网格中的同一行 space。它们是 table 中的 table（查看名称为 "strip" 的行，同时注意 zeroGrob；这些稍后会有用）：
z
## TableGrob (13 x 14) "layout": 34 grobs
## z cells name grob
## 1 0 ( 1-13, 1-14) background rect[plot.background..rect.522]
## 2 1 ( 7- 7, 4- 4) panel-1-1 gTree[panel-1.gTree.292]
...
## 20 3 ( 7- 7,12-12) axis-r-1 zeroGrob[NULL]
## 21 3 ( 9- 9,12-12) axis-r-2 zeroGrob[NULL]
## 22 2 ( 6- 6, 4- 4) strip-t-1 gtable[strip]
## 23 2 ( 6- 6, 6- 6) strip-t-2 gtable[strip]
## 24 2 ( 6- 6, 8- 8) strip-t-3 gtable[strip]
## 25 2 ( 6- 6,10-10) strip-t-4 gtable[strip]
## 26 2 ( 7- 7,11-11) strip-r-1 gtable[strip]
## 27 2 ( 9- 9,11-11) strip-r-2 gtable[strip]
...
## 32 8 ( 3- 3, 4-10) subtitle zeroGrob[plot.subtitle..zeroGrob.519]
## 33 9 ( 2- 2, 4-10) title zeroGrob[plot.title..zeroGrob.518]
## 34 10 (12-12, 4-10) caption zeroGrob[plot.caption..zeroGrob.520]
如果放大第一个条带，您可以看到嵌套结构：
z$grob[[22]]
## TableGrob (2 x 1) "strip": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) strip absoluteGrob[strip.absoluteGrob.451]
## 2 2 (2-2,1-1) strip absoluteGrob[strip.absoluteGrob.475]
对于每个 grob，我们有一个对象列出了它的绘制顺序 (z)、网格中的位置 (cells）、标签（名称）和几何图形（grob）。
因为我们可以在 gtables 中创建 gtables，我们将使用它来绘制我们的原始图。首先，我们需要找到图中需要替换的位置。
# Find the location of the strips in the main plot
locations <- grep("strip-t", z$layout$name)
# Filter out the strips (trim = FALSE is important here for positions relative to the main plot)
strip <- gtable_filter(z, "strip-t", trim = FALSE)
# Gathering our positions for the main plot
top <- strip$layout$t[1]
l <- strip$layout$l[c(1, 3)]
r <- strip$layout$r[c(2, 4)]
一旦我们有了位置，我们需要创建一个替换 table。我们可以用列表矩阵来做到这一点（是的，这很奇怪。随它去吧）。由于两个方面以及它们之间的间隙，在我们的例子中这个矩阵需要有三列和两行。由于稍后我们只是要替换矩阵中的数据，因此我们将创建一个 zeroGrobs:
mat <- matrix(vector("list", length = 6), nrow = 2)
mat[] <- list(zeroGrob())
# The separator for the facets has zero width
res <- gtable_matrix("toprow", mat, unit(c(1, 0, 1), "null"), unit(c(1, 1), "null"))
蒙版分两步创建，覆盖第一个面组，然后覆盖第二个面组。在第一部分中，我们使用之前记录的位置从原始图中抓取适当的 grob，并将其添加到我们的替换矩阵 res 之上，跨越整个长度。然后我们将该矩阵添加到我们的绘图之上。
# Adding the first layer
zz <- res %>%
gtable_add_grob(z$grobs[[locations[1]]]$grobs[[1]], 1, 1, 1, 3) %>%
gtable_add_grob(z, ., t = top, l = l[1], b = top, r = r[1], name = c("add-strip"))
# Adding the second layer (note the indices)
pp <- gtable_add_grob(res, z$grobs[[locations[3]]]$grobs[[1]], 1, 1, 1, 3) %>%
gtable_add_grob(zz, ., t = top, l = l[2], b = top, r = r[2], name = c("add-strip"))
# Plotting
grid.newpage()
print(grid.draw(pp))
我很抱歉破坏了这个线程和无意的自我推销，但我尝试将其概括为一个 facet_nested() 函数，它可以在 ggh4x 包中找到。
该功能没有经过广泛测试，但我认为它可能会给人们带来一些便利。也许从中会得到一些好的反馈。
我在这个函数中做了两个超出分组条带范围的修改。一是它不会自动扩展缺失的变量。这是因为我认为嵌套面应该能够与非嵌套面共存，而无需在 vars() 中的第二个或更多参数中添加任何条目，当使用两个 data.frames 进行绘图时。第二个是它将条带从外到内排序，因此即使设置了 switch，内层也比外层更靠近面板。
假设df是上面问题中的df，重现这个问题中的情节如下：
# library(ggh4x)
p <- ggplot(df, aes(x = x, y = y)) +
geom_point() +
facet_nested(f1 ~ f2 + f3)
还有 更真实的示例图，它会像下面这样工作，假设 df 是那个问题的 df：
p <- ggplot(df, aes("", density)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_nested(. ~ species + location + position) +
theme(panel.spacing=unit(0,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")
我遇到了一种情况，我想创建一个由三个分组变量分面的图。为此，我会简单地使用 facet_grid(f1 ~ f2 + f3)，但这里的问题是 f2 的标签是多余的，最好让它们跨越嵌套在 f2.[=13= 中的 f3 的各个方面。 ]
MWE：
library('tibble')
library('ggplot2')
df <- tribble(
~x, ~y, ~f1, ~f2, ~f3,
0.5, 0.5, "a", "a", "a",
0.5, 0.5, "b", "a", "a",
0.5, 0.5, "a", "b", "a",
0.5, 0.5, "b", "b", "a",
0.5, 0.5, "a", "a", "b",
0.5, 0.5, "b", "a", "b",
0.5, 0.5, "a", "b", "b",
0.5, 0.5, "b", "b", "b"
)
p <- ggplot(df, aes(x = x, y = y)) +
geom_point() +
facet_grid(f1 ~ f2 + f3)
同样，我希望合并 f2 的标签，这样它们就不会那么多余了。
编辑：这与其他问题的不同之处在于它询问如何使用现有分组来修改构面而不是添加新的构面。
答案在 grid 和 gtable 包中。情节中的所有内容都按特定顺序排列，如果您稍微挖掘一下，就可以找到所有内容的位置。
library('gtable')
library('grid')
library('magrittr') # for the %>% that I love so well
# First get the grob
z <- ggplotGrob(p)
此操作的最终目标是覆盖顶面标签，但诀窍在于这两个面都存在于网格中的同一行 space。它们是 table 中的 table（查看名称为 "strip" 的行，同时注意 zeroGrob；这些稍后会有用）：
z
## TableGrob (13 x 14) "layout": 34 grobs
## z cells name grob
## 1 0 ( 1-13, 1-14) background rect[plot.background..rect.522]
## 2 1 ( 7- 7, 4- 4) panel-1-1 gTree[panel-1.gTree.292]
...
## 20 3 ( 7- 7,12-12) axis-r-1 zeroGrob[NULL]
## 21 3 ( 9- 9,12-12) axis-r-2 zeroGrob[NULL]
## 22 2 ( 6- 6, 4- 4) strip-t-1 gtable[strip]
## 23 2 ( 6- 6, 6- 6) strip-t-2 gtable[strip]
## 24 2 ( 6- 6, 8- 8) strip-t-3 gtable[strip]
## 25 2 ( 6- 6,10-10) strip-t-4 gtable[strip]
## 26 2 ( 7- 7,11-11) strip-r-1 gtable[strip]
## 27 2 ( 9- 9,11-11) strip-r-2 gtable[strip]
...
## 32 8 ( 3- 3, 4-10) subtitle zeroGrob[plot.subtitle..zeroGrob.519]
## 33 9 ( 2- 2, 4-10) title zeroGrob[plot.title..zeroGrob.518]
## 34 10 (12-12, 4-10) caption zeroGrob[plot.caption..zeroGrob.520]
如果放大第一个条带，您可以看到嵌套结构：
z$grob[[22]]
## TableGrob (2 x 1) "strip": 2 grobs
## z cells name grob
## 1 1 (1-1,1-1) strip absoluteGrob[strip.absoluteGrob.451]
## 2 2 (2-2,1-1) strip absoluteGrob[strip.absoluteGrob.475]
对于每个 grob，我们有一个对象列出了它的绘制顺序 (z)、网格中的位置 (cells）、标签（名称）和几何图形（grob）。
因为我们可以在 gtables 中创建 gtables，我们将使用它来绘制我们的原始图。首先，我们需要找到图中需要替换的位置。
# Find the location of the strips in the main plot
locations <- grep("strip-t", z$layout$name)
# Filter out the strips (trim = FALSE is important here for positions relative to the main plot)
strip <- gtable_filter(z, "strip-t", trim = FALSE)
# Gathering our positions for the main plot
top <- strip$layout$t[1]
l <- strip$layout$l[c(1, 3)]
r <- strip$layout$r[c(2, 4)]
一旦我们有了位置，我们需要创建一个替换 table。我们可以用列表矩阵来做到这一点（是的，这很奇怪。随它去吧）。由于两个方面以及它们之间的间隙，在我们的例子中这个矩阵需要有三列和两行。由于稍后我们只是要替换矩阵中的数据，因此我们将创建一个 zeroGrobs:
mat <- matrix(vector("list", length = 6), nrow = 2)
mat[] <- list(zeroGrob())
# The separator for the facets has zero width
res <- gtable_matrix("toprow", mat, unit(c(1, 0, 1), "null"), unit(c(1, 1), "null"))
蒙版分两步创建，覆盖第一个面组，然后覆盖第二个面组。在第一部分中，我们使用之前记录的位置从原始图中抓取适当的 grob，并将其添加到我们的替换矩阵 res 之上，跨越整个长度。然后我们将该矩阵添加到我们的绘图之上。
# Adding the first layer
zz <- res %>%
gtable_add_grob(z$grobs[[locations[1]]]$grobs[[1]], 1, 1, 1, 3) %>%
gtable_add_grob(z, ., t = top, l = l[1], b = top, r = r[1], name = c("add-strip"))
# Adding the second layer (note the indices)
pp <- gtable_add_grob(res, z$grobs[[locations[3]]]$grobs[[1]], 1, 1, 1, 3) %>%
gtable_add_grob(zz, ., t = top, l = l[2], b = top, r = r[2], name = c("add-strip"))
# Plotting
grid.newpage()
print(grid.draw(pp))
我很抱歉破坏了这个线程和无意的自我推销，但我尝试将其概括为一个 facet_nested() 函数，它可以在 ggh4x 包中找到。
该功能没有经过广泛测试，但我认为它可能会给人们带来一些便利。也许从中会得到一些好的反馈。
我在这个函数中做了两个超出分组条带范围的修改。一是它不会自动扩展缺失的变量。这是因为我认为嵌套面应该能够与非嵌套面共存，而无需在 vars() 中的第二个或更多参数中添加任何条目，当使用两个 data.frames 进行绘图时。第二个是它将条带从外到内排序，因此即使设置了 switch，内层也比外层更靠近面板。
假设df是上面问题中的df，重现这个问题中的情节如下：
# library(ggh4x)
p <- ggplot(df, aes(x = x, y = y)) +
geom_point() +
facet_nested(f1 ~ f2 + f3)
还有 df 是那个问题的 df：
p <- ggplot(df, aes("", density)) +
geom_boxplot(width=0.7, position=position_dodge(0.7)) +
theme_bw() +
facet_nested(. ~ species + location + position) +
theme(panel.spacing=unit(0,"lines"),
strip.background=element_rect(color="grey30", fill="grey90"),
panel.border=element_rect(color="grey90"),
axis.ticks.x=element_blank()) +
labs(x="")