Patchwork inset_element() with facets

Question

I am trying to plot a facet plot. My idea is to display inset plots according to the facet. Here's a reproducible example using mtcars. The idea would be to get density plots for am=0 on the proper (am=0) facet at (0.5, 0.5, 1, 1). Same idea for am=1.

library(tidyverse)
library(patchwork)
p1 <- ggplot(mtcars, aes(cyl, mpg)) + 
  geom_point(color = "red") +
  facet_wrap(~am)
p2 <- ggplot(mtcars, aes(hp)) + 
  geom_density(aes(fill=factor(cyl), color=factor(cyl))) +
  facet_wrap(~am)
p1

p2

I understand why this is not functioning the way I want it. I am not sure if this should be a feature request to the library. (ideally, patchwork would automagically realize that the inset has to go on proper panels).

p1 + inset_element(p2, 0.5, 0.5, 1, 1)

^{Created on 2023-12-11 with reprex v2.0.2}

What is the way to do this? The only idea I can come up with is to subset the data and create each plot plus inset individually (subset the data, then plot, then return the plot, then use patchwork to bind the plots into a layout). Is there any other way?

Answer 1

The point of patchwork is to combine multiple plots. It makes no attempt to split apart multiple panels of the same faceted plot. It's also oblivious to the data used to create each plot, so adding this specific ability as a feature would seem to be against the design principles of the package.

I don't think matching insets by panel is a very common thing to do with facets either. If you want to do something like this, it is certainly possible with patchwork, but you will need to automate a process of subsetting and laying out your plot in the very specific way you want it.

The following 2 functions can be used to split and then merge arbitrary facets of two plots as long as they share the same facet groups:

split_facets <- function(p) {
  levs <- lapply(p$data[names(p$facet$params$facets)], \(x) levels(factor(x)))
  levs <- do.call('expand.grid', levs)
  lapply(seq(nrow(levs)), \(x) {
    p_new <- unserialize(serialize(p, NULL))
    p_new$data <- p_new$data[p_new$data[[match(names(levs)[1], 
                                    names(p_new$data))]] == levs[x, 1],]
    if(ncol(levs) > 1) {
      p_new$data <- p_new$data[p_new$data[[match(names(levs)[1], 
                      names(p_new$data))]] == levs[x, 1],]
    }
    return(p_new)
  })
}

merge_facets <- function(p1, p2) {
  Map(function(a, b) a + inset_element(b, 0.5, 0.5, 1, 1),
      split_facets(p1), split_facets(p2)) |> wrap_plots(guides = 'collect')
}

Testing on your example, we get:

merge_facets(p1, p2)