How to change the position of the zoomed area from facet_zoom()?

Question

With facet_zoom() from the ggforce package one can create nice zooms to highlight certain regions of a plot. Unfortunately, when zooming in on the y axis the original plot is always on the right side.

Is there a way to place the original plot on the left?

This would feel more intuitive to first look at the main plot and then at the zoomed region. As an example I would like to swap the position of the two facets in this plot:

(No reproducible example added, since I believe this is a question about the existence of a certain functionality.)

Windermere

looks like there is an open issue: github.com/thomasp85/ggforce/issues/73 – Bedlam

Ah yes, that is exactly what I was looking for. The issue is already open for over a year so I guess this feature won't be implemented in the near future. – Windermere

yeah, looks like it. But you can access the code and see if it can be tweaked for this purpose github.com/thomasp85/ggforce/blob/master/R/facet_zoom.R – Bedlam

@Windermere it would be great if you could post the source code for this example actually! Although, as you point out, the question pertains to certain functionality, it would benefit the reader because there aren't many examples of using facet_zoom() with a categorical / discrete variable. Nice plots. – Samphire

Answer 1

I've tweaked the current code for FacetZoom on GitHub to swop the horizontal order from [zoom, original] to [original, zoom]. The changes aren't complicated, but they are scattered throughout draw_panels() function's code, so the full code is rather long.

Result:

# example 1, with split = FALSE, horizontal = TRUE (i.e. default settings)
p1 <- ggplot(mtcars, aes(x = mpg, y = disp, colour = factor(cyl))) +
  geom_point() +
  theme_bw()    
p1 + ggtitle("Original") + facet_zoom(y = disp > 300)
p1 + ggtitle("Modified") + facet_zoom2(y = disp > 300)

# example 2, with split = TRUE
p2 <- ggplot(iris, aes(Petal.Length, Petal.Width, colour = Species)) +
  geom_point() +
  theme_bw()    
p2 + ggtitle("Original") + 
  facet_zoom(xy = Species == "versicolor", split = TRUE)
p2 + ggtitle("Modified") + 
  facet_zoom2(xy = Species == "versicolor", split = TRUE)

Code used (I've commented out the original code, where modified code is used, & indicated the packages for functions from other packages):

library(ggplot)
library(ggforce)
library(grid)

# define facet_zoom2 function to use FacetZoom2 instead of FacetZoom
# (everything else is the same as facet_zoom)
facet_zoom2 <- function(x, y, xy, zoom.data, xlim = NULL, ylim = NULL, 
                        split = FALSE, horizontal = TRUE, zoom.size = 2, 
                        show.area = TRUE, shrink = TRUE) {
  x <- if (missing(x)) if (missing(xy)) NULL else lazyeval::lazy(xy) else lazyeval::lazy(x)
  y <- if (missing(y)) if (missing(xy)) NULL else lazyeval::lazy(xy) else lazyeval::lazy(y)
  zoom.data <- if (missing(zoom.data)) NULL else lazyeval::lazy(zoom.data)
  if (is.null(x) && is.null(y) && is.null(xlim) && is.null(ylim)) {
    stop("Either x- or y-zoom must be given", call. = FALSE)
  }
  if (!is.null(xlim)) x <- NULL
  if (!is.null(ylim)) y <- NULL
  ggproto(NULL, FacetZoom2,
          shrink = shrink,
          params = list(
            x = x, y = y, xlim = xlim, ylim = ylim, split = split, zoom.data = zoom.data,
            zoom.size = zoom.size, show.area = show.area,
            horizontal = horizontal
          )
  )
}

# define FacetZoom as a ggproto object that inherits from FacetZoom,
# with a modified draw_panels function. the compute_layout function references
# the version currently on GH, which is slightly different from the CRAN
# package version.
FacetZoom2 <- ggproto(
  "FacetZoom2",
  ggforce::FacetZoom,

  compute_layout = function(data, params) {
    layout <- rbind( # has both x & y dimension
      data.frame(name = 'orig', SCALE_X = 1L, SCALE_Y = 1L),
      data.frame(name = 'x', SCALE_X = 2L, SCALE_Y = 1L),
      data.frame(name = 'y', SCALE_X = 1L, SCALE_Y = 2L),
      data.frame(name = 'full', SCALE_X = 2L, SCALE_Y = 2L),
      data.frame(name = 'orig_true', SCALE_X = 1L, SCALE_Y = 1L),
      data.frame(name = 'zoom_true', SCALE_X = 1L, SCALE_Y = 1L)
    )
    if (is.null(params$y) && is.null(params$ylim)) { # no y dimension
      layout <- layout[c(1,2, 5:6),]
    } else if (is.null(params$x) && is.null(params$xlim)) { # no x dimension
      layout <- layout[c(1,3, 5:6),]
    }
    layout$PANEL <- seq_len(nrow(layout))
    layout
  },

  draw_panels = function(panels, layout, x_scales, y_scales, ranges, coord,
                         data, theme, params) {

    if (is.null(params$x) && is.null(params$xlim)) {
      params$horizontal <- TRUE
    } else if (is.null(params$y) && is.null(params$ylim)) {
      params$horizontal <- FALSE
    }
    if (is.null(theme[['zoom']])) {
      theme$zoom <- theme$strip.background
    }
    if (is.null(theme$zoom.x)) {
      theme$zoom.x <- theme$zoom
    }
    if (is.null(theme$zoom.y)) {
      theme$zoom.y <- theme$zoom
    }
    axes <- render_axes(ranges, ranges, coord, theme, FALSE)
    panelGrobs <- ggforce:::create_panels(panels, axes$x, axes$y)
    panelGrobs <- panelGrobs[seq_len(length(panelGrobs) - 2)]
    if ('full' %in% layout$name && !params$split) {
      panelGrobs <- panelGrobs[c(1, 4)]
    }

    # changed coordinates in indicator / lines to zoom from 
    # the opposite horizontal direction
    if ('y' %in% layout$name) {
      if (!inherits(theme$zoom.y, 'element_blank')) {
        zoom_prop <- scales::rescale(
          y_scales[[2]]$dimension(ggforce:::expansion(y_scales[[2]])),
          from = y_scales[[1]]$dimension(ggforce:::expansion(y_scales[[1]])))
        indicator <- polygonGrob(
          x = c(0, 0, 1, 1), # was x = c(1, 1, 0, 0), 
          y = c(zoom_prop, 1, 0), 
          gp = gpar(col = NA, fill = alpha(theme$zoom.y$fill, 0.5)))
        lines <- segmentsGrob(
          x0 = c(1, 1), x1 = c(0, 0), # was x0 = c(0, 0), x1 = c(1, 1)
          y0 = c(0, 1), y1 = zoom_prop,
          gp = gpar(col = theme$zoom.y$colour,
                    lty = theme$zoom.y$linetype,
                    lwd = theme$zoom.y$size,
                    lineend = 'round'))
        indicator_h <- grobTree(indicator, lines)
      } else {
        indicator_h <- zeroGrob()
      }
    }

    if ('x' %in% layout$name) {
      if (!inherits(theme$zoom.x, 'element_blank')) {
        zoom_prop <- scales::rescale(x_scales[[2]]$dimension(ggforce:::expansion(x_scales[[2]])),
                                     from = x_scales[[1]]$dimension(ggforce:::expansion(x_scales[[1]])))
        indicator <- polygonGrob(c(zoom_prop, 1, 0), c(1, 1, 0, 0), 
                                 gp = gpar(col = NA, fill = alpha(theme$zoom.x$fill, 0.5)))
        lines <- segmentsGrob(x0 = c(0, 1), y0 = c(0, 0), x1 = zoom_prop, y1 = c(1, 1), 
                              gp = gpar(col = theme$zoom.x$colour,
                                        lty = theme$zoom.x$linetype,
                                        lwd = theme$zoom.x$size,
                                        lineend = 'round'))
        indicator_v <- grobTree(indicator, lines)
      } else {
        indicator_v <- zeroGrob()
      }
    }

    if ('full' %in% layout$name && params$split) {
      space.x <- theme$panel.spacing.x
      if (is.null(space.x)) space.x <- theme$panel.spacing
      space.x <- unit(5 * as.numeric(convertUnit(space.x, 'cm')), 'cm')
      space.y <- theme$panel.spacing.y
      if (is.null(space.y)) space.y <- theme$panel.spacing
      space.y <- unit(5 * as.numeric(convertUnit(space.y, 'cm')), 'cm')

      # change horizontal order of panels from [zoom, original] to [original, zoom]
      # final <- gtable::gtable_add_cols(panelGrobs[[3]], space.x)
      # final <- cbind(final, panelGrobs[[1]], size = 'first')
      # final_tmp <- gtable::gtable_add_cols(panelGrobs[[4]], space.x)
      # final_tmp <- cbind(final_tmp, panelGrobs[[2]], size = 'first')
      final <- gtable::gtable_add_cols(panelGrobs[[1]], space.x)
      final <- cbind(final, panelGrobs[[3]], size = 'first')
      final_tmp <- gtable::gtable_add_cols(panelGrobs[[2]], space.x)
      final_tmp <- cbind(final_tmp, panelGrobs[[4]], size = 'first')

      final <- gtable::gtable_add_rows(final, space.y)
      final <- rbind(final, final_tmp, size = 'first')
      final <- gtable::gtable_add_grob(final, list(indicator_h, indicator_h),
                                       c(2, 6), 3, c(2, 6), 5,
                                       z = -Inf, name = "zoom-indicator")
      final <- gtable::gtable_add_grob(final, list(indicator_v, indicator_v), 
                                       3, c(2, 6), 5, 
                                       z = -Inf, name = "zoom-indicator")
      heights <- unit.c(
        unit(max_height(list(axes$x[[1]]$top, axes$x[[3]]$top)), 'cm'),
        unit(1, 'null'),
        unit(max_height(list(axes$x[[1]]$bottom, axes$x[[3]]$bottom)), 'cm'),
        space.y,
        unit(max_height(list(axes$x[[2]]$top, axes$x[[4]]$top)), 'cm'),
        unit(params$zoom.size, 'null'),
        unit(max_height(list(axes$x[[2]]$bottom, axes$x[[4]]$bottom)), 'cm')
      )

      # swop panel width specifications according to the new horizontal order
      widths <- unit.c(
        # unit(max_width(list(axes$y[[3]]$left, axes$y[[4]]$left)), 'cm'),
        # unit(params$zoom.size, 'null'),
        # unit(max_height(list(axes$y[[3]]$right, axes$y[[4]]$right)), 'cm'),
        # space.x,
        # unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'),
        # unit(1, 'null'),
        # unit(max_height(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm')        
        unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'),
        unit(1, 'null'),
        unit(max_height(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm'),
        space.x,
        unit(max_width(list(axes$y[[3]]$left, axes$y[[4]]$left)), 'cm'),
        unit(params$zoom.size, 'null'),
        unit(max_height(list(axes$y[[3]]$right, axes$y[[4]]$right)), 'cm')

      )
      final$heights <- heights
      final$widths <- widths
    } else {
      if (params$horizontal) {
        space <- theme$panel.spacing.x
        if (is.null(space)) space <- theme$panel.spacing
        space <- unit(5 * as.numeric(convertUnit(space, 'cm')), 'cm')
        heights <- unit.c(
          unit(max_height(list(axes$x[[1]]$top, axes$x[[2]]$top)), 'cm'),
          unit(1, 'null'),
          unit(max_height(list(axes$x[[1]]$bottom, axes$x[[2]]$bottom)), 'cm')
        )

        # change horizontal order of panels from [zoom, original] to [original, zoom]
        # first <- gtable::gtable_add_cols(panelGrobs[[2]], space)
        # first <- cbind(final, panelGrobs[[1]], size = 'first')
        final <- gtable::gtable_add_cols(panelGrobs[[1]], space) 
        final <- cbind(final, panelGrobs[[2]], size = "first") 

        final$heights <- heights

        # swop panel width specifications according to the new horizontal order
        # unit(c(params$zoom.size, 1), 'null')
        final$widths[panel_cols(final)$l] <- unit(c(1, params$zoom.size), 'null') 

        final <- gtable::gtable_add_grob(final, indicator_h, 2, 3, 2, 5, 
                                         z = -Inf, name = "zoom-indicator")
      } else {
        space <- theme$panel.spacing.y
        if (is.null(space)) space <- theme$panel.spacing
        space <- unit(5 * as.numeric(convertUnit(space, 'cm')), 'cm')
        widths <- unit.c(
          unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'),
          unit(1, 'null'),
          unit(max_height(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm')
        )
        final <- gtable::gtable_add_rows(panelGrobs[[1]], space)
        final <- rbind(final, panelGrobs[[2]], size = 'first')
        final$widths <- widths
        final$heights[panel_rows(final)$t] <- unit(c(1, params$zoom.size), 'null')
        final <- gtable::gtable_add_grob(final, indicator_v, 3, 2, 5, 
                                         z = -Inf, name = "zoom-indicator")
      }
    }
    final
  }
)

Note: create_panels and expansion are un-exported functions from the ggforce package, so I referenced them with triple colons. This isn't robust for writing packages, but should suffice as a temporary workaround.

Update 30 Oct 2019: A suggestion for those seeing errors like Invalid 'type' (list) of argument after trying to use this solution as-is. The issue is likely due to updates made to the ggforcepackage since this solution was developed. To get the code in this solution working again, install the version of ggforce that was available when the solution was developed. This can be done with the devtools package pointing to the 4008a2e commit:

devtools::install_github("thomasp85/ggforce", ref = '4008a2e')

Rondon

Nice, exactly what I was looking for! I didn't have the time to look into the code myself, so thanks for sharing. Will definitely give this a try. – Windermere

When you load the ggplot package, do you mean that or the ggplot2 package? I cannot find the ggplot package. – Romp

In 2022 for anyone attempting to install the commit from github you'll need to install first the units commit from that time: devtools::install_github("r-quantities/units", ref = "1bfe46aae32112b03e222c5c78137d15be8c0f2f") this to avoid the error Error: object ‘as.units’ is not exported by 'namespace:units' – Liva

And answering to @Romp yes, there is a typo, you need the ggplot2 package – Liva

@RodrigoZepeda, is the solution working for you now? I tried to install it from the commit, however I get the following error: "(...) ggforce_0.1.1.tar.gz’ had non-zero exit status". – Sidwel

@JorgeV do you have more information on the error? Non-zero exit status only says there was an error during installation. It could be for example a problem with your compiler toolchain or a problem with one of the dependencies that somehow changed. – Liva

Answer 2

Coming back in 2024 to add an update that works with the newer ggforce_0.4.2 package and the same basics as Rodrigo Zepeda's answer above. Also having packages vctrs, gTable, plyr, grid, and lazyEval:

library(grid)
library(vctrs)
library(gTable)
library(plyr)
library(lazyEval)
library(ggforce)
library(ggplot2)

facet_zoom2 <- function(x, y, xy, zoom.data, xlim = NULL, ylim = NULL,
                        split = FALSE, horizontal = TRUE, zoom.size = 2,
                        show.area = TRUE, shrink = TRUE) 
{x <- if (missing(x)) if (missing(xy)) NULL else enquo(xy) else enquo(x)
y <- if (missing(y)) if (missing(xy)) NULL else enquo(xy) else enquo(y)
zoom.data <- if (missing(zoom.data)) NULL else enquo(zoom.data)
if (is.null(x) && is.null(y) && is.null(xlim) && is.null(ylim))
{
  cli::cli_abort('Either x- or y-zoom must be given')
}
if (!is.null(xlim)) x <- NULL
if (!is.null(ylim)) y <- NULL
ggproto(NULL, FacetZoom,
        shrink = shrink,
        params = list(
          x = x, y = y, xlim = xlim, ylim = ylim, split = split,
          zoom.data = zoom.data, zoom.size = zoom.size, show.area = show.area,
          horizontal = horizontal
        )
)
}

FacetZoom <- ggproto('FacetZoom', Facet,
                     compute_layout = function(data, params) {
                       layout <- data.frame(
                         name = c('orig', 'x', 'y', 'full', 'orig_true', 'zoom_true'),
                         SCALE_X = c(1L, 2L, 1L, 2L, 1L, 1L),
                         SCALE_Y = c(1L, 1L, 2L, 2L, 1L, 1L)
                       )
                       if (is.null(params$y) && is.null(params$ylim)) {
                         layout <- layout[c(1, 2, 5:6), ]
                       } else if (is.null(params$x) && is.null(params$xlim)) {
                         layout <- layout[c(1, 3, 5:6), ]
                       }
                       layout$PANEL <- seq_len(nrow(layout))
                       layout
                     },
                     map_data = function(data, layout, params) {
                       if (empty(data)) {
                         return(cbind(data, PANEL = integer(0)))
                       }
                       vec_rbind(
                         cbind(data, PANEL = 1L),
                         if (!is.null(params$x)) {
                           index_x <- try_fetch(eval_tidy(params$x, data),
                                                error = function(e) FALSE)
                           if (sum(index_x, na.rm = TRUE) != 0) {
                             cbind(data[index_x, ], PANEL = layout$PANEL[layout$name == 'x'])
                           }
                         },
                         if (!is.null(params$y)) {
                           index_y <- try_fetch(eval_tidy(params$y, data),
                                                error = function(e) FALSE)
                           if (sum(index_y, na.rm = TRUE) != 0) {
                             cbind(data[index_y, ], PANEL = layout$PANEL[layout$name == 'y'])
                           }
                         },
                         if (!is.null(params$zoom.data)) {
                           zoom_data <- try_fetch(eval_tidy(params$zoom.data, data),
                                                  error = function(e) NA)
                           zoom_data <- rep(zoom_data, length.out = nrow(data))
                           zoom_ind <- zoom_data | is.na(zoom_data)
                           orig_ind <- !zoom_data | is.na(zoom_data)
                           vec_rbind(
                             cbind(data[zoom_ind, ], PANEL = if (any(zoom_ind))  layout$PANEL[layout$name == 'zoom_true'] else integer(0)),
                             cbind(data[orig_ind, ], PANEL = if (any(orig_ind)) layout$PANEL[layout$name == 'orig_true'] else integer(0))
                           )
                         }
                       )
                     },
                     train_scales = function(self, x_scales, y_scales, layout, data, params) {
                       # Remove any limits settings on the zoom panels
                       if (length(x_scales) > 1) x_scales[[2]]$limits <- NULL
                       if (length(y_scales) > 1) y_scales[[2]]$limits <- NULL
                       # loop over each layer, training x and y scales in turn
                       for (layer_data in data) {
                         match_id <- match(layer_data$PANEL, layout$PANEL)
                         
                         if (!is.null(x_scales)) {
                           if ('x' %in% layout$name && x_scales[[1]]$is_discrete()) {
                             cli::cli_abort('facet_zoom doesn\'t support zooming in discrete scales')
                           }
                           x_vars <- intersect(x_scales[[1]]$aesthetics,   names(layer_data))
                           SCALE_X <- layout$SCALE_X[match_id]
                           
                           if (!is.null(params$xlim) && length(x_scales) > 1) {
                             x_scales[[2]]$train(x_scales[[2]]$transform(params$xlim))
                             scale_apply(layer_data, x_vars, 'train', SCALE_X, x_scales[-2])
                           } else {
                             scale_apply(layer_data, x_vars, 'train', SCALE_X,    x_scales)
                           }
                         }
                         
                         if (!is.null(y_scales)) {
                           if ('y' %in% layout$name && y_scales[[1]]$is_discrete()) {
                             cli::cli_abort('facet_zoom doesn\'t support zooming in discrete scales')
                           }
                           y_vars <- intersect(y_scales[[1]]$aesthetics, names(layer_data))
                           SCALE_Y <- layout$SCALE_Y[match_id]
                           
                           if (!is.null(params$ylim) && length(y_scales) > 1) {
                             y_scales[[2]]$train(y_scales[[2]]$transform(params$ylim))
                             scale_apply(layer_data, y_vars, 'train', SCALE_Y, y_scales[-2])
                           } else {
                             scale_apply(layer_data, y_vars, 'train', SCALE_Y,  y_scales)
                           }
                         }
                       }
                     },
                     finish_data = function(data, layout, x_scales, y_scales, params)   {
                       plot_panels <- which(!grepl('_true', layout$name))
                       data <- if (is.null(params$zoom.data)) {
                         vec_rbind(!!!lapply(layout$PANEL[plot_panels],   function(panel) {
                           d <- data[data$PANEL == 1, ]
                           d$PANEL <- panel
                           d
                         }))
                       } else {
                         orig_pan <- layout$PANEL[layout$name == 'orig_true']
                         zoom_pan <- layout$PANEL[layout$name == 'zoom_true']
                         orig_data <- data[data$PANEL == orig_pan, ]
                         orig_data$PANEL <- if (nrow(orig_data) != 0) 1L else integer(0)
                         zoom_data <- data[data$PANEL == zoom_pan, ]
                         vec_rbind(orig_data, vec_rbind(!!!lapply(plot_panels[-1], function(panel) {
                           zoom_data$PANEL <- if (nrow(zoom_data) != 0) panel else integer(0)
                           zoom_data
                         })))
                       }
                       data$PANEL <- factor(data$PANEL, layout$PANEL)
                       data
                     },
                     draw_panels = function(self, panels, layout, x_scales, y_scales, ranges, coord,
                                            data, theme, params) {
                       if (inherits(coord, 'CoordFlip')) {
                         cli::cli_abort('facet_zoom doesn\'t work with flipped scales')
                       }
                       if (is.null(params$x) && is.null(params$xlim)) {
                         params$horizontal <- TRUE
                       } else if (is.null(params$y) && is.null(params$ylim)) {
                         params$horizontal <- FALSE
                       }
                       
                       zoom_x <- calc_element('zoom.x', theme)
                       zoom_y <- calc_element('zoom.y', theme)
                       
                       # Construct the panels
                       axes <- render_axes(ranges, ranges, coord, theme, FALSE)
                       panelGrobs <- create_panels(panels, axes$x, axes$y)
                       panelGrobs <- panelGrobs[seq_len(length(panelGrobs) - 2)]
                       
                       if ('full' %in% layout$name && !params$split) {
                         panelGrobs <- panelGrobs[c(1, 4)]
                       }
                       
                       if ('y' %in% layout$name) {
                         if (!inherits(zoom_y, 'element_blank')) {
                           zoom_prop <- rescale(y_scales[[2]]$dimension(expansion(y_scales[[2]])),
                                                from = y_scales[[1]]$dimension(expansion(y_scales[[1]]))
                           )
                           indicator <- polygonGrob(
                             c(0, 0, 1, 1),
                             c(zoom_prop, 1, 0),
                             gp = gpar(col = NA, fill = alpha(zoom_y$fill, 0.5))
                           )
                           lines <- segmentsGrob(
                             y0 = c(1, 1),
                             x0 = c(0, 1),
                             y1 = zoom_prop,
                             x1 = c(1, 1),
                             gp = gpar(
                               col = zoom_y$colour,
                               lty = zoom_y$linetype,
                               lwd = (zoom_y$linewidth %||% zoom_y$size) * .pt,
                               lineend = 'round'
                             )
                           )
                           indicator_h <- grobTree(indicator, lines)
                         } else {
                           indicator_h <- zeroGrob()
                         }
                       }
                       if ('x' %in% layout$name) {
                         if (!inherits(zoom_x, 'element_blank')) {
                           zoom_prop <- rescale(x_scales[[2]]$dimension(expansion(x_scales[[2]])),
                                                from = x_scales[[1]]$dimension(expansion(x_scales[[1]]))
                           )
                           indicator <- polygonGrob(
                             c(zoom_prop, 1, 0),
                             c(1, 1, 0, 0),
                             gp = gpar(col = NA, fill = alpha(zoom_x$fill, 0.5))
                           )
                           lines <- segmentsGrob(
                             x0 = c(0, 1),
                             y0 = c(0, 0),
                             x1 = zoom_prop,
                             y1 = c(1, 1),
                             gp = gpar(
                               col = zoom_x$colour,
                               lty = zoom_x$linetype,
                               lwd = (zoom_x$linewidth %||% zoom_x$size) * .pt,
                               lineend = 'round'
                             )
                           )
                           indicator_v <- grobTree(indicator, lines)
                         } else {
                           indicator_v <- zeroGrob()
                         }
                       }
                       
                       if ('full' %in% layout$name && params$split) {
                         space.x <- theme$panel.spacing.x
                         if (is.null(space.x)) space.x <- theme$panel.spacing
                         space.x <- unit(5 * as.numeric(convertUnit(space.x, 'cm')), 'cm')
                         space.y <- theme$panel.spacing.y
                         if (is.null(space.y)) space.y <- theme$panel.spacing
                         space.y <- unit(5 * as.numeric(convertUnit(space.y, 'cm')), 'cm')
                         final <- gtable_add_cols(panelGrobs[[3]], space.x)
                         final <- cbind(final, panelGrobs[[1]], size = 'first')
                         final_tmp <- gtable_add_cols(panelGrobs[[4]], space.x)
                         final_tmp <- cbind(final_tmp, panelGrobs[[2]], size = 'first')
                         final <- gtable_add_rows(final, space.y)
                         final <- rbind(final, final_tmp, size = 'first')
                         final <- gtable_add_grob(final, list(indicator_h, indicator_h), c(2, 6), 3,
                                                  c(2, 6), 5, z = -Inf, name = 'zoom-indicator')
                         final <- gtable_add_grob(final, list(indicator_v, indicator_v), 3, c(2, 6),
                                                  5, z = -Inf, name = 'zoom-indicator')
                         heights <- unit.c(
                           unit(max_height(list(axes$x[[1]]$top, axes$x[[3]]$top)), 'cm'),
                           unit(1, 'null'),
                           unit(max_height(list(axes$x[[1]]$bottom,    axes$x[[3]]$bottom)), 'cm'),
                           space.y,
                           unit(max_height(list(axes$x[[2]]$top, axes$x[[4]]$top)), 'cm'),
                           unit(params$zoom.size, 'null'),
                           unit(max_height(list(axes$x[[2]]$bottom, axes$x[[4]]$bottom)), 'cm')
                         )
                         widths <- unit.c(
                           ## unit(max_width(list(axes$y[[3]]$left, axes$y[[4]]$left)), 'cm'),
                           ## unit(params$zoom.size, 'null'),
                           ## unit(max_width(list(axes$y[[3]]$right, axes$y[[4]]$right)), 'cm'), space.x,
                           ## unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'),
                           ## unit(1, 'null'),
                           ## unit(max_width(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm')
                           
                           unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'),
                           unit(1, 'null'),
                           unit(max_height(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm'),
                           space.x,
                           unit(max_width(list(axes$y[[3]]$left, axes$y[[4]]$left)), 'cm'),
                           unit(params$zoom.size, 'null'),
                           unit(max_height(list(axes$y[[3]]$right,     axes$y[[4]]$right)), 'cm')
                         )
                         final$heights <- heights
                         final$widths <- widths
                       } else {
                         if (params$horizontal) {
                           space <- theme$panel.spacing.x
                           if (is.null(space)) space <- theme$panel.spacing
                           space <- unit(5 * as.numeric(convertUnit(space, 'cm')), 'cm')
                           heights <- unit.c(
                             unit(max_height(list(axes$x[[1]]$top, axes$x[[2]]$top)), 'cm'),
                             unit(1, 'null'),
                             unit(max_height(list(axes$x[[1]]$bottom, axes$x[[2]]$bottom)), 'cm')
                           )
                           
                           final <- gtable::gtable_add_cols(panelGrobs[[1]], space) 
                           final <- cbind(final, panelGrobs[[2]], size = "first") 
                           
                           ## final <- gtable_add_cols(panelGrobs[[2]], space)
                           ## final <- cbind(final, panelGrobs[[1]], size = 'first')
                           final$heights <- heights
                           
                           final$widths[panel_cols(final)$l] <- unit(c(1, params$zoom.size), 'null') 
                           ## final$widths[panel_cols(final)$l] <- unit(c(params$zoom.size, 1), 'null')
                           
                           
                           final <- gtable_add_grob(final, indicator_h, 2, 3, 2, 5, z = -Inf,
                                                    name = 'zoom-indicator')
                         } else {
                           space <- theme$panel.spacing.y
                           if (is.null(space)) space <- theme$panel.spacing
                           space <- unit(5 * as.numeric(convertUnit(space, 'cm')),  'cm')
                           widths <- unit.c(
                             unit(max_width(list(axes$y[[1]]$left, axes$y[[2]]$left)), 'cm'),
                             unit(1, 'null'),
                             unit(max_width(list(axes$y[[1]]$right, axes$y[[2]]$right)), 'cm')
                           )
                           final <- gtable_add_rows(panelGrobs[[1]], space)
                           final <- rbind(final, panelGrobs[[2]], size = 'first')
                           final$widths <- widths
                           final$heights[panel_rows(final)$t] <- unit(c(1, params$zoom.size), 'null')
                           final <- gtable_add_grob(final, indicator_v, 3, 2, 5, z = -Inf,
                                                    name = 'zoom-indicator')
                         }
                       }
                       final
                     },
                     draw_back = function(data, layout, x_scales, y_scales, theme, params) {
                       zoom_x <- calc_element('zoom.x', theme)
                       zoom_y <- calc_element('zoom.y', theme)
                       
                       if (!(is.null(params$x) && is.null(params$xlim)) &&
                           params$show.area && !inherits(zoom_x, 'element_blank') && length(x_scales) > 1) {
                         zoom_prop <- rescale(x_scales[[2]]$dimension(expansion(x_scales[[2]])),
                                              from = x_scales[[1]]$dimension(expansion(x_scales[[1]]))
                         )
                         x_back <- grobTree(
                           rectGrob(x = mean(zoom_prop), y = 0.5, width =   diff(zoom_prop),
                                    height = 1,
                                    gp = gpar(col = NA, fill = alpha(zoom_x$fill, 0.5))),
                           segmentsGrob(zoom_prop, c(0, 0), zoom_prop, c(1, 1), gp =    gpar(
                             col = zoom_x$colour,
                             lty = zoom_x$linetype,
                             lwd = (zoom_x$linewidth %||% zoom_x$size) * .pt,
                             lineend = 'round'
                           ))
                         )
                       } else {
                         x_back <- zeroGrob()
                       }
                       if (!(is.null(params$y) && is.null(params$ylim)) &&
                           params$show.area && !inherits(zoom_y, 'element_blank') && length(y_scales) > 1) {
                         zoom_prop <- rescale(y_scales[[2]]$dimension(expansion(y_scales[[2]])),
                                              from = y_scales[[1]]$dimension(expansion(y_scales[[1]]))
                         )
                         y_back <- grobTree(
                           rectGrob(y = mean(zoom_prop), x = 0.5, height = diff(zoom_prop),
                                    width = 1,
                                    gp = gpar(col = NA, fill = alpha(zoom_y$fill, 0.5))),
                           segmentsGrob(y0 = zoom_prop, x0 = c(0, 0), y1 = zoom_prop,    x1 = c(1, 1),
                                        gp = gpar(col = zoom_y$colour,
                                                  lty = zoom_y$linetype,
                                                  lwd = (zoom_y$linewidth %||% zoom_y$size) * .pt,
                                                  lineend = 'round'
                                        )
                           )
                         )
                       } else {
                         y_back <- zeroGrob()
                       }
                       if ('full' %in% layout$name && params$split) {
                         list(grobTree(x_back, y_back), y_back, x_back, zeroGrob(), zeroGrob(),
                              zeroGrob())
                       } else {
                         list(grobTree(x_back, y_back), zeroGrob(), zeroGrob(),     zeroGrob())
                       }
                     }
)
#' @importFrom grid grobHeight grobWidth unit unit.c
#' @importFrom gtable gtable gtable_add_grob
create_panels <- function(panels, x.axis, y.axis) {
  Map(function(panel, x, y, i) {
    heights <- unit.c(grobHeight(x$top), unit(1, 'null'), grobHeight(x$bottom))
    widths <- unit.c(grobWidth(y$left), unit(1, 'null'), grobWidth(y$right))
    table <- gtable(widths, heights)
    table <- gtable_add_grob(table, panel, t = 2, l = 2, z = 2, clip = 'on',
                             name = paste0('panel-', i))
    table <- gtable_add_grob(table, x, t = c(1, 3), l = 2, z = 4, clip = 'off',
                             name = paste0(c('axis-t-', 'axis-b-'), i))
    table <- gtable_add_grob(table, y, t = 2, l = c(1, 3), z = 4, clip = 'off',
                             name = paste0(c('axis-l-', 'axis-r-'), i))
  }, panel = panels, x = x.axis, y = y.axis, i = seq_along(panels))
}

expansion <- function(scale, discrete = c(0, 0.6), continuous = c(0.05, 0)) {
  if (inherits(scale$expand, 'waiver')) {
    if (scale$is_discrete()) {
      discrete
    } else {
      continuous
    }
  } else {
    scale$expand
  }
}

# Helpers       -----------------------------------------------------------------

split_with_index <- function(x, f, n = max(f)) {
  if (n == 1) return(list(x))
  f <- as.integer(f)
  attributes(f) <- list(levels = as.character(seq_len(n)), class = "factor")
  unname(split(x, f))
}

# Function for applying scale method to multiple variables in a given
# data set.  Implement in such a way to minimize copying and hence maximise
# speed
scale_apply <- function(data, vars, method, scale_id, scales) {
  if (length(vars) == 0) return()
  if (nrow(data) == 0) return()
  
  if (any(is.na(scale_id))) {
    cli::cli_abort("{.arg scale_id} must not contain any {.val NA}")
  }
  
  scale_index <- split_with_index(seq_along(scale_id), scale_id,     length(scales))
  
  lapply(vars, function(var) {
    pieces <- lapply(seq_along(scales), function(i) {
      scales[[i]][[method]](data[[var]][scale_index[[i]]])
    })
    # Remove empty vectors to avoid coercion issues with vctrs
    pieces[lengths(pieces) == 0] <- NULL
    o <- order(unlist(scale_index))[seq_len(sum(lengths(pieces)))]
    vec_c(!!!pieces)[o]
  })
}

Fraga

Edited to add packages used in codeblock as opposed to just in text---not sure what specific versions were used, but I know it's made it through an update of R and its base packages so its a fairly resilient fix version wise! – Fraga