如何像在facet_grid中一样将标签放置在facet_wrap中

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)

我可以接受上述骇客尝试，但是我想知道是否有什么facet_wrap可以允许所需的输出。我觉得我错过了一些显而易见的事情，也许我在寻找答案时没有包含正确的关键词（我觉得这个问题之前已经解决过）。

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

现在我们可以很容易地将 的顶部刻面条替换g1为g2

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)

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 (top extent)、l(left extent)、b (bottom extent)和的准确值r(right extent)可能需要试错法

现在对 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