rggplot2gtable

overwrite a facet panel with custom plot


I am using package:gtable to substitute a summary plot into an empty facet panel. Consider the following example:

library(ggplot2)
library(gtable)
library(glue)
library(purrr) # for purrr::partial

get_panel = function(st, x, y) {
  if (missing(x) && missing(y)) {
    name = "panel"
  } else {
    name = glue("panel-{x}-{y}")
  }

  i = st$layout[grep(name, st$layout$name), "t"]
  j = st$layout[grep(name, st$layout$name), "l"]

  st[i, j]
}

get_axis = function(st, pos, x, y) {
  if (missing(x) && missing(y)) {
    name = glue("axis-{pos}")
  } else {
    name = glue("axis-{pos}-{x}-{y}")
  }
  i = st$layout[grep(name, st$layout$name), "t"]
  j = st$layout[grep(name, st$layout$name), "l"]

  if (length(c(i, j)) < 2L) {
    NULL
  } else {
    st[i, j]
  }
}

p = ggplot(mtcars) +
  aes(x = wt, y = mpg, color = factor(am)) +
  geom_point() +
  facet_wrap(~factor(cyl), ncol = 2)

sub = ggplot(mtcars) +
  aes(x = factor(cyl), fill = factor(am)) +
  geom_bar(position = "fill") +
  scale_fill_discrete(guide = "none") +
  scale_y_continuous(NULL, position = "right",
    labels = scales::percent) +
  xlab(NULL)


row = 2
col = 2

gt = ggplotGrob(p)
st = ggplotGrob(sub)

new_panel = get_panel(st)
new_axis_b = get_axis(st, "b")
new_axis_r = get_axis(st, "r")

panel_name = glue("panel-{row}-{col}")
panel_idx = grep(panel_name, gt$layout$name)
panel_layout = as.list(gt$layout[panel_idx, c("t", "l", "b", "r")])
axis_b_name = glue("axis-b-{row}-{col}")
axis_b_idx = grep(axis_b_name, gt$layout$name)
axis_b_layout = as.list(gt$layout[axis_b_idx, c("t", "l", "b", "r")])
axis_r_name = glue("axis-r-{row}-{col}")
axis_r_idx = grep(axis_r_name, gt$layout$name)
axis_r_layout = as.list(gt$layout[axis_r_idx, c("t", "l", "b", "r")])

# overwrite panel and axis
result = gt |>
  partial(gtable_add_grob, !!!panel_layout)(grobs = new_panel$grob) |>
  partial(gtable_add_grob, !!!axis_b_layout)(grobs = new_axis_b$grob) |>
  partial(gtable_add_grob, !!!axis_r_layout)(grobs = new_axis_r$grob)

plot(result)

enter image description here

This is very close to what I want, but I'm struggling with the following:

  1. how can I add spacing between the right-y axis of the substitute plot and the guide?
  2. In other examples, there is no entry in the gtable for e.g. axis-r-2-2. How can I force the original facet plot to include (empty) placeholders for missing components? If this isn't possible, how can I add those components to the gtable?

Solution

  • Concerning your first question you can add a new column to the gtable layout to make room for the right axis. As is you are placing the axis in the "spacer" column which separates the guide from the plot. And in principle the same approach should work if there is no axis-r element. Perhaps you can add an example for this case, too?

    library(gtable)
    library(purrr)
    library(grid)
    
    # Get width of axis
    axis_r_width <- grid::grobWidth(new_axis_r) |> grid::convertWidth("cm")
    
    result <- gt |>
      partial(gtable_add_grob, !!!panel_layout)(grobs = new_panel$grob) |>
      partial(gtable_add_grob, !!!axis_b_layout)(grobs = new_axis_b$grob) |>
      gtable_add_cols(axis_r_width, pos = axis_r_layout$r) |>
      partial(gtable_add_grob, !!!axis_r_layout)(grobs = new_axis_r$grob)
    
    plot(result)
    

    enter image description here