ggplot2中的嵌套分面跨组

Question

我遇到了这样的情况：我想创建一个按三个分组变量分面的绘图。为此，我可以简单地使用 facet_grid(f1 ~ f2 + f3)，但问题在于f2的标签会是多余的，最好让它们跨越f2内嵌于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变量的标签合并，以减少冗余。

编辑：与其他问题不同之处在于它询问如何使用现有的分组来修改分面图，而不是添加新的分组。

- ZNK

Answer 1

抱歉打扰这个帖子并且无意间自我推广，但我尝试将其泛化为一个facet_nested()函数，并可以在ggh4x包中找到。

这个函数没有经过广泛测试，但我认为它可能对人们有些方便。也许会有一些好的反馈。

除了分组条之外，我对此函数进行了两个其他修改。一个是它不会自动扩展缺失的变量。这是因为我认为嵌套的面板应该能够与非嵌套的面板共存，即使在使用两个数据框绘图时也不需要在vars()的第二个或更多参数中输入任何条目。另一个是它按外部到内部的顺序对条形进行排序，以便内部比外部更靠近面板，即使设置了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="")

- teunbrand

---

我认为ggplot坚持的理念是，ggplot2包中的函数应该是1.普遍适用且维护成本低或者2.是必要的功能。考虑到它没有经过大量测试（维护成本高）并且不是必要的功能，这最好适用于扩展包。 - teunbrand

facet_nested 绝对是我长期以来一直想要的东西；感谢您重新提出。就功能而言，唯一需要请求的是一个额外的主题设置杠杆，通过嵌套调整面板间距。可能一个嵌套深度乘数就足够了 - 即，如果最低级别面板之间的间距为1，则向上一级为1.1，向上两级为1.1^2，依此类推。 - Carl

我在一个简单的例子中遇到了以下错误： Error in do.call(unit.c, lapply(splitstrip, max_height)) : object 'unit.c' not found 该例子如下：ggplot(mpg, aes(x= cty, y = hwy)) + geom_point() + facet_nested(.~ manufacturer + model) - jlp

@wolfsatthedoor 你是怎么找到那个包的？我试图链接到现在托管此函数的ggh4x包，而不是ggnomics，但显然你被引导到了错误的包。 - teunbrand

ggh4x中也有一个名为facet_nested_wrap的函数。如果这个函数不符合您的需求，我需要更多的细节信息。 - teunbrand

Answer 2

这个问题的答案在于 grid 和 gtable 包。图形中的所有内容都按照特定顺序排列，如果你仔细查找，就可以找到每个元素的位置。

library('gtable')
library('grid')
library('magrittr') # for the %>% that I love so well

# First get the grob
z <- ggplotGrob(p) 

这个操作的最终目标是叠加顶部的 facet 标签，但是技巧在于这两个 facet 存在于同一行的网格空间中。它们是一个表格内的表格（查看名称为 "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），标签（name）和几何形状（grob）。

由于我们可以在gtable内创建gtable，因此我们将使用它来在原始图表上进行绘制。首先，我们需要找到需要替换的图表位置。

# 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)]

一旦我们有了位置，我们需要创建一个替换表。我们可以使用一个列表矩阵来完成这个任务（是的，很奇怪，但请接受它）。因为有两个方面和它们之间的间隙，所以在我们的情况下，这个矩阵需要有三列和两行。由于我们只是稍后要在矩阵中替换数据，所以我们将使用zeroGrob创建一个矩阵：

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))

- ZNK

---

非常感谢您提供的解决方案。我一直在努力想出如何将此解决方案推广到修改图表右侧的分面标签。您能演示如何修改您的解决方案以适应基于绘图函数ggplot(cbind(df,df), aes(x = x, y = y)) + geom_point() + facet_grid(f1 + f2 ~ f3)的情况吗？我还需要将12个分面行推广到6个外部右标签，而不是4个和2个（因为我提供的重写函数会产生这些标签）。如果有帮助的话，我很乐意提供一个清晰的例子。非常感谢！ - nickb

嗨@nickb，你可能想看看https://dev59.com/bFkS5IYBdhLWcg3wJDYP#55911134 - ZNK

谢谢分享一个好的解决方案。由于在facet_wrap(~id + id2, nrow = 4, ncol=8)设置中有多行，我无法使它正常工作。这可能只是我没有完全理解如何调整你的解决方案或忽略了一些愚蠢的东西。请参见 https://dev59.com/N7vpa4cB1Zd3GeqPAumU （带有最小可行示例和创建的绘图）。 - Björn