get rid of empty panels in the first row of facet_grid

Question

I was trying to use facet_grid to lay out panels, for example,

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)

My question is, how can I get ride of the first 7 panels (and the last 4), leaving them totally blank?

Answer 1

I have found this easiest to do by editing the panel grobs in a gtable before plotting.

First lets save the ggplot object in 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)

Now we can remove the panels before plotting. I demonstrate using cowplot::plot_to_gtable, although there are also several other packages that provide functions to convert a ggplot into a 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)

We can also move up the axes for the empty cells like this:

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

With the current development version of ggplot2 (see below *), the names of the panel grobs in the gtable are corrected to 'panel-[row]-[col]'.

This allows to use gtable_filter() to manually remove certain panels by their names (e.g. 'panel-6-8') in a straightforward way:

# 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(.)}

^{Created on 2020-05-01 by the reprex package (v0.3.0)}

To identify panel names I use the following snippet:

# 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(.)}

^{Created on 2020-05-01 by the reprex package (v0.3.0)}

You can get the newest development version of ggplot2* with remotes::install_github("tidyverse/ggplot2").

* ggplot2 version as of 2020-05-01, commit: #e0f1040c1217585b22111b2ed11cd967320dcccd