如何在facet_wrap中定位条形标签，就像在facet_grid中一样

Question

我希望在使用facet_wrap()进行分面且两个变量和两个刻度都自由缩放时，能够消除条形标签的冗余。

例如，下面这张图的facet_wrap版本：

library(ggplot2)
dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]

ggplot(dt, aes(median, sales)) +
  geom_point() +
  facet_wrap(c("year", "month"), 
             labeller = "label_both", 
             scales = "free")

应该具有这个 facet_grid 版本的外观，其中条带标签位于图形的顶部和右侧边缘（也可以是底部和左侧边缘）。

ggplot(dt, aes(median, sales)) +
  geom_point() +
  facet_grid(c("year", "month"), 
             labeller = "label_both", 
             scales = "free")

不幸的是，使用facet_grid不是一种选择，因为据我所知，它不允许比例尺“完全自由” - 请参见此处或这里

我考虑过的一种尝试是生成单独的图形，然后将它们组合起来：

library(cowplot)
theme_set(theme_gray()) 

p1 <- ggplot(dt[dt$year == 2000,], aes(median, sales)) +
  geom_point() +
  facet_wrap("month", scales = "free") +
  labs(y = "2000") + 
  theme(axis.title.x = element_blank())

p2 <- ggplot(dt[dt$year == 2001,], aes(median, sales)) +
  geom_point() +
  facet_wrap("month", scales = "free") +
  labs(y = "2001") + 
  theme(strip.background = element_blank(),
        strip.text.x = element_blank(),
        axis.title.x = element_blank())

p3 <- ggplot(dt[dt$year == 2002,], aes(median, sales)) +
  geom_point() +
  facet_wrap("month", scales = "free") +
  labs(y = "2002") + 
  theme(strip.background = element_blank(),
        strip.text.x = element_blank())

plot_grid(p1, p2, p3, nrow = 3)

我对上述的hackish尝试感到满意，但我想知道在facet_wrap中是否有什么东西可以实现所需的输出。我觉得我可能错过了一些显而易见的东西，也许我的搜索答案并没有包含正确的关键词（我有这样的感觉这个问题以前已经被解决过）。

- Valentin_Ștefan

Answer 1

这似乎并不容易，但一种方法是使用网格图形将facet_grid绘制的面板条插入到作为facet_wrap创建的面板中。可以像这样：

首先，让我们使用facet_grid和facet_wrap创建两个绘图。

dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]

g1 = ggplot(dt, aes(median, sales)) +
  geom_point() +
  facet_wrap(c("year", "month"), scales = "free") +
  theme(strip.background = element_blank(),
        strip.text = element_blank())

g2 = ggplot(dt, aes(median, sales)) +
  geom_point() +
  facet_grid(c("year", "month"), scales = "free")

现在，我们可以相对容易地用g2的顶部平面条替换g1的平面条。

library(grid)
library(gtable) 
gt1 = ggplot_gtable(ggplot_build(g1))
gt2 = ggplot_gtable(ggplot_build(g2))
gt1$grobs[grep('strip-t.+1$', gt1$layout$name)] = gt2$grobs[grep('strip-t', gt2$layout$name)]
grid.draw(gt1)

要添加右侧面板条，我们需要先在网格布局中添加一列，然后将相关的条形图形粘贴到其中：

gt.side1 = gtable_filter(gt2, 'strip-r-1')
gt.side2 = gtable_filter(gt2, 'strip-r-2')
gt.side3 = gtable_filter(gt2, 'strip-r-3')

gt1 = gtable_add_cols(gt1, widths=gt.side1$widths[1], pos = -1)
gt1 = gtable_add_grob(gt1, zeroGrob(), t = 1, l = ncol(gt1), b=nrow(gt1))

panel_id <- gt1$layout[grep('panel-.+1$', gt1$layout$name),]
gt1 = gtable_add_grob(gt1, gt.side1, t = panel_id$t[1], l = ncol(gt1))
gt1 = gtable_add_grob(gt1, gt.side2, t = panel_id$t[2], l = ncol(gt1))
gt1 = gtable_add_grob(gt1, gt.side3, t = panel_id$t[3], l = ncol(gt1))

grid.newpage()
grid.draw(gt1)

- dww

---

嗨@dww。抱歉耽搁了。我喜欢你的两步方法。我试过了，只需要进行一些小修改就可以运行 - 我认为在编辑gt1添加新列时，你需要用gt1$widths[1]替换gt.side1$widths[1]。 - Valentin_Ștefan

到目前为止，我没有注意到，但是当您用gt2$grobs覆盖gt1$grobs时，它会覆盖上部面板的一些顶点。我认为首先应该添加一个顶行 gt1 <- gtable_add_rows(gt1, heights = unit(0.5, 'cm'), pos = 2)，然后使用类似于gt1 <- gtable_add_grob(gt1, grobs = gt2$grobs[grep('strip-t', gt2$layout$name)], t = 2, l = gt1$layout[grep('strip-t.+1$', gt1$layout$name),]$l)的方法添加顶部facet标签。 - Valentin_Ștefan

感谢 @Valentin 指出这个问题。代码的顺序是错误的（在分配之前使用了 gt.side1）。现在已经修复了。 - dww

我折腾了一下。发布的解决方案不起作用，但是当我删除了gt.side3部分后它就可以了。之后，我尝试修复左上角，看起来有点偏移。您可以通过使用theme（plot.margin=unit(c(1,0.65,0,0),"cm")) 来将右侧面板带到绘图中。如果您想要完美，可以通过调整最终gt1对象的高度来将顶部面板向上移动，如下所示：gt1$heights[7] <- unit(0.6, "cm")。在您的情况下，它不必是项目编号7。也许这可以帮助未来的任何人。 - BerriJ

现在有了ggh4x包中的facet_grid2函数，这变得非常容易。请看我的解决方案。 - UseR10085

Answer 2

我不确定你是否可以只使用facet_wrap来完成这个任务，所以你的尝试可能是正确的。但是在我看来，它需要改进。目前，你缺少实际的y-lab（销售额），这有点误导了y- axis中绘制的内容。

你可以通过使用gtable和grid添加另一行绘图标题来改进你正在进行的工作。

p1 <- ggplot(dt[dt$year == 2000,], aes(median, sales)) +
  geom_point() +
  facet_wrap("month", scales = "free") +
  theme(axis.title.x = element_blank())

p2 <- ggplot(dt[dt$year == 2001,], aes(median, sales)) +
  geom_point() +
  facet_wrap("month", scales = "free") +
  theme(axis.title.x = element_blank())

p3 <- ggplot(dt[dt$year == 2002,], aes(median, sales)) +
  geom_point() +
  facet_wrap("month", scales = "free")

请注意，上述图表中已删除labs。

if ( !require(grid) )    { install.packages("grid");    library(grid) }
if ( !require(gtable ) )   { install.packages("gtable");    library(gtable) }

z1 <- ggplotGrob(p1) # Generate a ggplot2 plot grob
z1 <- gtable_add_rows(z1, unit(0.6, 'cm'), 2) # add new rows in specified position

z1 <- gtable_add_grob(z1,
                    list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
                         textGrob("2000", gp = gpar(col = "black",cex=0.9))),
                    t=2, l=4, b=3, r=13, name = paste(runif(2))) #add grobs into the table

请注意，在步骤3中，获取t（顶部范围）、l（左侧范围）、b（底部范围）和r（右侧范围）的确切值可能需要试错方法。

现在重复上述步骤以获得p2和p3。

z2 <- ggplotGrob(p2)
z2 <- gtable_add_rows(z2, unit(0.6, 'cm'), 2) 

z2 <- gtable_add_grob(z2,
                      list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
                           textGrob("2001", gp = gpar(col = "black",cex=0.9))),
                      t=2, l=4, b=3, r=13, name = paste(runif(2))) 

z3 <- ggplotGrob(p3) 
z3 <- gtable_add_rows(z3, unit(0.6, 'cm'), 2)

z3 <- gtable_add_grob(z3,
                      list(rectGrob(gp = gpar(col = NA, fill = gray(0.7))),
                           textGrob("2002", gp = gpar(col = "black",cex=0.9))),
                      t=2, l=4, b=3, r=13, name = paste(runif(2))) 

最后，绘图

plot_grid(z1, z2, z3, nrow = 3)

你也可以像在facet_grid中一样，在列中显示年份。在这种情况下，您需要使用gtable_add_cols添加一列。但请确保(a)在步骤2中在正确的位置添加列，并且(b)在步骤3中获取t、l、b和r的正确值。

- rm167

---

"plot_grid" 似乎已经被弃用，有没有更新的替代方法？ - elcortegano

@elcortegano，它并没有被弃用，你应该使用cowplot::plot_grid()。 - Dion Groothof

Answer 3

您可以使用ggh4x包中的facet_grid2函数来实现这一点，如下所示：

library(ggplot2)
library(ggh4x)

dt <- txhousing[txhousing$year %in% 2000:2002 & txhousing$month %in% 1:3,]

ggplot(dt, aes(median, sales)) +
  geom_point() +
  facet_grid2(c("year", "month"), 
             labeller = "label_both", 
             scales = "free", independent = "all")

- UseR10085