Produce an inset in each facet of an R ggplot while preserving colours of the original facet content

Question

I would like to produce a graphic combining four facets of a graph with insets in each facet showing a detail of the respective plot. This is one of the things I tried:

Answer 1

Here is a solution based on Z. Lin's answer, but using ggforce::facet_wrap_paginate() to do the filtering and keeping colourscales consistent.

First, we can make the 'root' plot containing all the data with no facetting.

library(ggpmisc)
library(tibble)
library(dplyr)

n_replicates <- c(rep(1:10,15),rep(seq(10,100,10),15),rep(seq(100,1000,100),15),rep(seq(1000,10000,1000),15))
sim_years <- rep(sort(rep((1:15),10)),4)
sd_data <- rep (NA,600)
for (i in 1:600) {
  sd_data[i]<-rnorm(1,mean=exp(0.1 * sim_years[i]), sd= 1/n_replicates[i])
}
max_rep <- sort(rep(c(10,100,1000,10000),150))
data_frame <- cbind.data.frame(n_replicates,sim_years,sd_data,max_rep)


my_breaks = c(2, 10, 100, 1000, 10000)
facet_names <- c(
  `10` = "2, 3, ..., 10 replicates",
  `100` = "10, 20, ..., 100 replicates",
  `1000` = "100, 200, ..., 1000 replicates",
  `10000` = "1000, 2000, ..., 10000 replicates"
)

base <- ggplot(data=data_frame, 
                aes(x=sim_years,y=sd_data,group =n_replicates, col=n_replicates)) + 
  geom_line() + 
  theme_bw() +
  scale_colour_gradientn(
    name = "number of replicates",
    trans = "log10", breaks = my_breaks,
    labels = my_breaks, colours = rainbow(20)
  ) +
  labs(title ="",  x = "year", y = "sd")

Next, the main plot will be just the root plot with facet_wrap().

main <- base + facet_wrap(~ max_rep, ncol = 2, labeller = as_labeller(facet_names))

Then the new part is to use facet_wrap_paginate with nrow = 1 and ncol = 1 for every max_rep, which we'll use as insets. The nice thing is that this does the filtering and it keeps colour scales consistent with the root plot.

nmax_rep <- length(unique(data_frame$max_rep))

insets <- lapply(seq_len(nmax_rep), function(i) {
  base + ggforce::facet_wrap_paginate(~ max_rep, nrow = 1, ncol = 1, page = i) +
    coord_cartesian(xlim = c(12, 14), ylim = c(3, 4)) +
    guides(colour = "none", x = "none", y = "none") +
    theme(strip.background = element_blank(),
          strip.text = element_blank(),
          axis.title = element_blank(),
          plot.background = element_blank())
})
insets <- tibble(x = rep(0.01, nmax_rep),
                 y = rep(10.01, nmax_rep),
                 plot = insets,
                 max_rep = unique(data_frame$max_rep))

main +
  geom_plot_npc(data = insets, 
                aes(npcx = x, npcy = y, label = plot,
                    vp.width = 0.3, vp.height = 0.6)) +
  annotate(geom = "rect", 
           xmin = 12, xmax = 14, ymin = 3, ymax = 4,
           linetype = "dotted", fill = NA, colour = "black") 

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