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)

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?

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)

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?

• r
• ggplot2
• gtable

Share Improve this question Follow asked Feb 12 at 20:46 mikeckmikeck 3,78811 gold badge2929 silver badges4242 bronze badges

Add a comment  | 

2 Answers 2

Sorted by: Reset to default 2

Alternatively, you might recreate the facets more manually and put it all together using patchwork:

library(patchwork)
make_facet <- function(var, val) {
  ggplot(mtcars |> filter({{var}} == val)) +
    aes(x = wt, y = mpg, color = factor(am)) +
    geom_point() +
    facet_wrap(vars({{var}}), ncol = 2)
}

make_facet(cyl, 4) + make_facet(cyl, 6) + make_facet(cyl, 8) +
  sub +
  plot_layout(ncol = 2, guides = "collect", axes = "collect")

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)