Set coordinates for individual ggplot2 facets

facet_setter.R

if (packageVersion("ggplot2") < "3.1.0") {
    stop("Need to use new version of ggplot!")
} else { 
    library(ggplot2)
}

UniquePanelCoords <- ggplot2::ggproto(
  "UniquePanelCoords", ggplot2::CoordCartesian,
  
  num_of_panels = 1,
  panel_counter = 1,
  panel_ranges = NULL,
  
  setup_layout = function(self, layout, params) {
    self$num_of_panels <- length(unique(layout$PANEL))
    self$panel_counter <- 1
    layout
  },
  
  setup_panel_params =  function(self, scale_x, scale_y, params = list()) {
    if (!is.null(self$panel_ranges) & length(self$panel_ranges) != self$num_of_panels)
      stop("Number of panel ranges does not equal the number supplied")
    
    train_cartesian <- function(scale, limits, name, given_range = NULL) {
      if (is.null(given_range))
        range <- ggplot2:::scale_range(scale, limits, self$expand)
      else
        range <- given_range
      
      out <- scale$break_info(range)
      out$arrange <- scale$axis_order()
      names(out) <- paste(name, names(out), sep = ".")
      out
    }
    
    cur_panel_ranges <- self$panel_ranges[[self$panel_counter]]
    if (self$panel_counter < self$num_of_panels)
      self$panel_counter <- self$panel_counter + 1
    else
      self$panel_counter <- 1
    
    c(train_cartesian(scale_x, self$limits$x, "x", cur_panel_ranges$x),
      train_cartesian(scale_y, self$limits$y, "y", cur_panel_ranges$y))
  }
)

coord_panel_ranges <- function(panel_ranges, expand = TRUE, default = FALSE, clip = "on") 
{
  ggplot2::ggproto(NULL, UniquePanelCoords, panel_ranges = panel_ranges, 
          expand = expand, default = default, clip = clip)
}


################### Examples ###########################################################################

test_data <- structure(list(DataType = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 
1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 
2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("A", "B"), class = "factor"), 
    ExpType = structure(c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 
    2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L), .Label = c("X", "Y"), class = "factor"), 
    EffectSize = structure(c(1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 
    1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 
    2L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L), .Label = c("15", "35"
    ), class = "factor"), Nsubjects = c(8, 16, 32, 64, 8, 16, 
    32, 64, 8, 16, 32, 64, 8, 16, 32, 64, 8, 16, 32, 64, 8, 16, 
    32, 64, 8, 16, 32, 64, 8, 16, 32, 64), Odds = c(1.06248116259846, 
    1.09482076720863, 1.23086993413208, 1.76749340505612, 1.06641831731573, 
    1.12616954196688, 1.48351814320987, 3.50755080416964, 1.11601399761081, 
    1.18352602009495, 1.45705466646283, 2.53384744810515, 1.13847061762186, 
    1.24983742407086, 1.97075900741022, 6.01497152563726, 1.02798821372378, 
    1.06297006279249, 1.19432835697453, 1.7320754674107, 1.02813271730924, 
    1.09355953747203, 1.44830680332583, 3.4732692664923, 1.06295915758305, 
    1.12008443626365, 1.3887632112682, 2.46321037334, 1.06722652223114, 
    1.1874936754725, 1.89870184372054, 5.943747409114), Upper = c(1.72895843644471, 
    2.09878774769559, 2.59771794965346, 5.08513435549015, 1.72999898901071, 
    1.8702196882561, 3.85385388850167, 5.92564404180303, 1.99113042576373, 
    2.61074135841984, 3.45852331828636, 4.83900142207583, 1.57897154221764, 
    1.8957409107653, 10, 75, 2.3763918424135, 2.50181951057562, 
    3.45037180395673, 3.99515276392065, 2.04584535265976, 2.39317394040066, 
    2.832526733659, 5.38414183471915, 1.40569501856836, 2.6778044191832, 
    2.98023068052396, 4.75934650422069, 1.54116883311054, 2.50647989271592, 
    3.48517589981551, 100), Lower = c(0.396003888752214, 0.0908537867216577, 
    -0.135978081389309, -1.55014754537791, 0.40283764562075, 
    0.382119395677663, -0.88681760208193, 1.08945756653624, 0.240897569457892, 
    -0.243689318229938, -0.544413985360706, 0.228693474134466, 
    0.69796969302609, 0.603933937376415, 0.183548809738402, 3.57236968943798, 
    -0.320415414965949, -0.375879384990643, -1.06171509000767, 
    -0.531001829099242, 0.010420081958713, -0.206054865456611, 
    0.0640868729926525, 1.56239669826544, 0.720223296597732, 
    -0.437635546655903, -0.202704257987574, 0.167074242459314, 
    0.593284211351745, -0.131492541770921, 0.312227787625573, 
    3.76692741957876)), .Names = c("DataType", "ExpType", "EffectSize", 
"Nsubjects", "Odds", "Upper", "Lower"), class = c("tbl_df", "tbl", 
"data.frame"), row.names = c(NA, -32L))

# Bad plot:
test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2)

# Better plot
test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2) +
  coord_panel_ranges(panel_ranges = list(
    list(x=c(8,64), y=c(1,4)), # Panel 1
    list(x=c(8,64), y=c(1,6)), # Panel 2
    list(NULL),                # Panel 3, an empty list falls back on the default values
    list(x=c(8,64), y=c(1,7))  # Panel 4
  ))

@burchill, any chance you've had reason to update this with ggplot2 since they removed scale_range in tidyverse/ggplot2@7f317d4? I've been able to get a little into it, with

      train_cartesian <- function(scale, limits, name, given_range = NULL) {
        if (is.null(given_range)) {
-         range <- scale_range(scale, limits, self$expand)
+         expansion <- ggplot2:::default_expansion(scale, expand = self$expand)
+         range <- ggplot2:::expand_limits_scale(scale, expansion,
+                                                coord_limits = self$limits[[name]])
        } else {
          range <- given_range
        }
        
        out <- scale$break_info(range)
        out$arrange <- scale$axis_order()
        names(out) <- paste(name, names(out), sep = ".")
        out
      }

(I'm not certain that's perfect, but it does produce the same output as the old scale_range used to return.)

But I'm falling flat on my face with:

test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2) +
  coord_panel_ranges(panel_ranges = list(
    list(x=c(8,64), y=c(1,4)), # Panel 1
    list(x=c(8,64), y=c(1,6)), # Panel 2
    list(NULL),                # Panel 3, an empty list falls back on the default values
    list(x=c(8,64), y=c(1,7))  # Panel 4
  ))
# Error in panel_params$x$break_positions_minor() : 
#   attempt to apply non-function
#      x
#   1. +-(function (x, ...) ...
#   2. \-ggplot2:::print.ggplot(x)
#   3.   +-ggplot2::ggplot_gtable(data)
#   4.   \-ggplot2:::ggplot_gtable.ggplot_built(data)
#   5.     \-layout$render(geom_grobs, data, theme, plot$labels)
#   6.       \-ggplot2:::f(..., self = self)
#   7.         \-base::lapply(...)
#   8.           \-ggplot2:::FUN(X[[i]], ...)
#   9.             \-self$coord$render_bg(self$panel_params[[i]], theme)
#  10.               \-ggplot2:::f(...)
#  11.                 \-ggplot2:::guide_grid(...)
#  12.                   \-base::setdiff(x.minor, x.major)
#  13.                     \-base::as.vector(x)

@burchill, I think I have figured out a way ahead.

I adapted (heavily) your code into https://gist.github.com/r2evans/6057f7995c117bb787495dc14a228d5d, which implements coord_cartesian_panels. Besides the function name itself, it now uses a data frame with facet variables and min/max columns to match against the faceted variables, enabling each of the following:

p <- test_data %>%
  ggplot(aes(x=Nsubjects, y = Odds, color=EffectSize)) +
  facet_wrap(DataType ~ ExpType, labeller = label_both, scales="free") +
  geom_line(size=2) +
  geom_ribbon(aes(ymax=Upper, ymin=Lower, fill=EffectSize, color=NULL), alpha=0.2)

# a replica of your plot
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~DataType, ~ExpType, ~ymin, ~ymax
  , "A"      , "X"     ,     1,     4
  , "A"      , "Y"     ,     1,     6
  , "B"      , "Y"     ,     1,     7
  )
)

# extension, subset of facet variables
p + coord_cartesian_panels(
  panel_limits = tibble::tribble(
    ~ExpType, ~ymin, ~ymax
  , "X"     ,    NA,     4
  , "Y"     ,     1,     5
  )
)

This was enabled by some help on my stackoverflow question.

Thanks, @r2evans! Sorry about the radio silence, I just started a job while working on my dissertation, so I've been swamped.
That looks absolutely awesome!

My one possible recommendation (take this how you will, based on your preferences of coding style) might be doing something like this:

coord_cartesian_panels <- function(..., panel_limits = NULL, 
                                   expand = TRUE, default = FALSE, clip = "on") {
  if (is.null(panel_limits))   panel_limits <- tribble::tribble(...)
  ggplot2::ggproto(NULL, UniquePanelCoords,
                   panel_limits = panel_limits,
                   expand = expand, default = default, clip = clip)
}
# You could then do:
p + coord_cartesian_panels(
  ~ExpType, ~ymin, ~ymax
  , "X"     ,    NA,     4
  , "Y"     ,     1,     5
)

This should let your users save a little typing (by letting them use the tribble input system automatically), while still giving them the option of using the longer, more flexible input system (via panel_limits argument) if they want.

That's an appealing feature! I have used polymorphic functions with similar ... functionality, my only concern is consistency with the rest of the ggplot2 dialect.

FYI, I've been chatting some with teunbrand, author of https://github.com/teunbrand/ggh4x, which does something similar but falls into the same trap of using panel-order in a list. I know it's not evil, but I really really prefer to be able to not care about order (and holes), since my use-cases tend to be programmatic both in the number and, at times, order of panels. Granted, since my code changes the order, one would think that I can control that, but ... anyway, you know what I mean.

I might fork and contribute to teunbrand's project, because I really like ability to arbitrarily add scale_* per panel.

Again, thanks for the impetus, and good luck with the new job and your dissertation.

FYI, I troubleshot some stupid typos of my own and then found one in yours: tribble::tribble --> tibble::tribble.

Thanks, I do like that extension. (I incorporated it into my gist.)

hmmm. this isn't working for me. I'm getting an error when I run your test:

Error in panel_params$x$break_positions_minor() : 
  attempt to apply non-function

not sure how to fix....