摆脱 facet_grid 第一行中的空面板

Question

例如，我试图使用facet_grid 来布置面板，

library(tidyverse)
library(lubridate)
economics %>%
  filter(date >= ymd(19680101)) %>% 
  mutate(
    year = year(date),
    month = month(date),
    decade = floor(year/10) * 10,
    single = year - decade,
    decade = paste0(decade, "s")
  ) %>% 
  ggplot(aes(month, uempmed)) +
  geom_point() +
  facet_grid(decade ~ single)

我的问题是，我怎样才能获得前 7 个面板（以及最后 4 个），让它们完全空白？

Answer 1

我发现通过在绘图前编辑 gtable 中的面板 grobs 最容易做到这一点。

首先让我们将ggplot对象保存在myplot中

myplot <- economics %>%
  filter(date >= ymd(19680101)) %>% 
  mutate(
    year = year(date),
    month = month(date),
    decade = floor(year/10) * 10,
    single = year - decade,
    decade = paste0(decade, "s")
  ) %>% 
  ggplot(aes(month, uempmed)) +
  geom_point() +
  facet_grid(decade ~ single)

现在我们可以在绘图之前移除面板。我演示了使用cowplot::plot_to_gtable，尽管还有其他几个包提供了将 ggplot 转换为 gtable 的功能。

library(cowplot)
library(grid)
gt <- plot_to_gtable(myplot)
to.delete = which (gt$layout$t == 8 & gt$layout$r <= 19 & grepl('panel', gt$layout$name))
to.delete = c(to.delete, which(gt$layout$t == 18 & gt$layout$r >= 17 & grepl('panel', gt$layout$name)))

gt$grobs[to.delete] <- NULL
gt$layout <- gt$layout[-to.delete, ]
grid.newpage()
grid.draw(gt)

我们也可以像这样向上移动空单元格的轴：

to.move = which(gt$layout$r >= 17 & grepl('axis-b', gt$layout$name))
gt$layout$t[to.move] <- gt$layout$t[to.move] - 2
gt$layout$b[to.move] <- gt$layout$b[to.move] - 2
grid.newpage()
grid.draw(gt)

Answer 2

使用ggplot2的当前开发版本（见下文*），gtable中的面板名称grobs更正为'panel-[row]-[col]'。

这允许使用gtable_filter() 以直接的方式手动删除某些面板的名称（例如'panel-6-8'）：

# remotes::install_github("tidyverse/ggplot2")
library(ggplot2)
library(dplyr)
library(lubridate)

myplot <- economics %>%
  filter(date >= ymd(19680101)) %>% 
  mutate(year = year(date),
         month = month(date),
         decade = floor(year/10) * 10,
         single = year - decade,
         decade = paste0(decade, "s")) %>% 
  ggplot(aes(month, uempmed)) +
  geom_point() +
  facet_grid(decade ~ single)

myplot %>%
  # Generate gtable of ggplot object
  ggplot2::ggplot_build() %>% ggplot2::ggplot_gtable() %>%
  # Modify gtable by filtering out grobs based on name using a regex pattern
  # $ represents end of string. Otherwise 'panel-1-1' removes 'panel-1-10', too.
  gtable::gtable_filter(pattern = "panel-1-1$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-2$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-3$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-4$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-5$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-6$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-7$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-1-8$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-6-7$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-6-8$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-6-9$", invert = TRUE) %>%
  gtable::gtable_filter(pattern = "panel-6-10$", invert = TRUE) %>%
  # Plot the modified gtable
  {grid::grid.newpage(); grid::grid.draw(.)}

^{由reprex package (v0.3.0) 于 2020 年 5 月 1 日创建}

为了识别面板名称，我使用以下 sn-p：

# Plot panel-names
# Extract  panels from the gtable layout (incl. their names and positions)
gtable_panel_positions <- myplot %>% 
  ggplotGrob() %>%
  magrittr::extract2("layout") %>%
  filter(grepl("panel-",name))

# Generate grobs with labels
grobs_to_add <- 
  sprintf("name: '%s'\ngtable index: [%d,%d]",
        gtable_panel_positions$name,
        gtable_panel_positions$t,
        gtable_panel_positions$l) %>%
  lapply(grid::textGrob, gp=grid::gpar(fontsize=5))

# Add grobs with labels and plot
myplot %>% 
  ggplotGrob() %>%
  gtable::gtable_add_grob(grobs = grobs_to_add,
                          t=gtable_panel_positions$t, 
                          l=gtable_panel_positions$l) %>%
  {grid::grid.newpage(); grid::grid.draw(.)}

^{由reprex package (v0.3.0) 于 2020 年 5 月 1 日创建}

您可以通过remotes::install_github("tidyverse/ggplot2") 获得ggplot2* 的最新开发版本。

* ggplot2 2020-05-01 版本，提交：#e0f1040c1217585b22111b2ed11cd967320dcccd