per-facet panel range clipping

coord_cartesian_panels.R

#' Cartesian coordinates per facet-panel
#'
#' This function mimics the behavior of [ggplot2::coord_cartesian()],
#' while supporting per-panel limits when faceted.
#'
#' @details
#'
#' A 'panel_limits' data frame may contain:
#'
#' - zero or more faceting variables, all of which must be found
#'   within the grob's 'layout' (i.e., defined by
#'   [ggplot2::facet_grid()] or [ggplot2::facet_wrap()];
#' 
#' - zero or more of 'xmin', 'xmax', 'ymin', and 'ymax', where missing
#'   columns and 'NA' values within columns will default to ggplot2's
#'   normal min/max determination;
#'
#' - each panel in the plot must match no more than one row in
#'   'panel_limits';
#'
#' - each row may match more than one panel, such as when some
#'   faceting variables are not included (in 'panel_limits');
#'
#' - if no faceting variables are included, then 'panel_limits' must
#'   be at most one row (in which case it effectively falls back to
#'   [ggplot2::coord_cartesian()] behavior).
#'
#' It is an error if:
#'
#' - a panel is matched by more than one row (no matches is okay);
#' 
#' - a faceting variable in 'panel_limits' is not found within the
#'   faceted layout.
#'
#' @section Thanks:
#'
#' - burchill (github) and the original version;
#'   https://gist.github.com/burchill/d780d3e8663ad15bcbda7869394a348a
#' 
#' - Z.Lin (stackoverflow) for helping me through some of the
#'   initial errors; https://stackoverflow.com/a/63556918
#'
#' - teunbrand (github and stackoverflow), possible future extension
#'   of the non-list-index version; https://github.com/teunbrand/ggh4x
#'
#' @examples
#' \dontrun{
#' 
#' library(dplyr)
#' library(tidyr)
#' library(ggplot2)
#'
#' testdata <- tibble(
#'   x = rep(1:100, 2),
#'   y = rep(sin(seq(0,2*pi,length.out=100)), 2)
#' ) %>%
#'   mutate(y1 = y - 0.3, y2 = y + 0.3) %>%
#'   tidyr::crossing(
#'     tidyr::expand_grid(facet1 = c("aa", "bb"), facet2 = c("11", "22"))
#'   )
#' 
#' gg <- ggplot(testdata, aes(x, y)) +
#'   geom_ribbon(aes(ymin = y1, ymax = y2), fill = "#ff8888aa") +
#'   geom_path(color = "red", size = 1) +
#'   facet_wrap(facet1 + facet2 ~ ., scales = "free")
#' gg
#'
#' # single-panel change,
#' gg + coord_cartesian_panels(
#'   panel_limits = tribble(
#'     ~facet1, ~facet2, ~ymin, ~ymax
#'   , "aa"   , "22"   , -0.75,   0.5
#'   )
#' )
#'
#' # subset of facet variables, optionally tribble-style
#' gg + coord_cartesian_panels(
#'     ~facet2, ~ymin, ~ymax
#'   , "22"   , -0.75,   0.5
#' )
#' 
#' # use of 'NA' for default limits
#' gg + coord_cartesian_panels(
#'   , "aa"   ,    "11", -0.75,   0.5
#'   , "bb"   ,    "22",    NA,   0.5
#' )
#' 
#' }
#' 
#' @param panel_limits 'data.frame' with faceting variables and
#'   limiting variables, see 'Details'
#' @param expand,default,clip as defined/used in
#'   [ggplot2::coord_cartesian()]
#' @export
#' @md
coord_cartesian_panels <- function(..., panel_limits = NULL,
                                   expand = TRUE, default = FALSE, clip = "on") {
  if (is.null(panel_limits)) panel_limits <- tibble::tibble(...)
  ggplot2::ggproto(NULL, UniquePanelCoords,
                   panel_limits = panel_limits,
                   expand = expand, default = default, clip = clip)
}

UniquePanelCoords <- ggplot2::ggproto(
  "UniquePanelCoords", ggplot2::CoordCartesian,
  
  num_of_panels = 1,
  panel_counter = 1,
  layout = NULL,
  
  setup_layout = function(self, layout, params) {
    self$num_of_panels <- length(unique(layout$PANEL))
    self$panel_counter <- 1
    self$layout <- layout # store for later
    layout
  },
  
  setup_panel_params =  function(self, scale_x, scale_y, params = list()) {
    train_cartesian <- function(scale, limits, name, given_range = c(NA, NA)) {
      if (anyNA(given_range)) {
        expansion <- ggplot2:::default_expansion(scale, expand = self$expand)
        range <- ggplot2:::expand_limits_scale(scale, expansion, coord_limits = limits)
        isna <- is.na(given_range)
        given_range[isna] <- range[isna]
      }
      # https://stackoverflow.com/a/75861761/3358272
      if (scale$is_discrete()) limits <- scale$get_limits()
      #
      out <- list(
        ggplot2:::view_scale_primary(scale, limits, given_range),
        sec = ggplot2:::view_scale_secondary(scale, limits, given_range),
        arrange = scale$axis_order(),
        range = given_range
      )
      names(out) <- c(name, paste0(name, ".", names(out)[-1]))
      out
    }

    this_layout <- self$layout[ self$panel_counter,, drop = FALSE ]
    self$panel_counter <- 
      if (self$panel_counter < self$num_of_panels) {
        self$panel_counter + 1
      } else 1

    # determine merge column names by removing all "standard" names
    layout_names <- setdiff(names(this_layout),
                            c("PANEL", "ROW", "COL", "SCALE_X", "SCALE_Y"))
    limits_names <- setdiff(names(self$panel_limits),
                            c("xmin", "xmax", "ymin", "ymax"))

    limits_extras <- setdiff(limits_names, layout_names)
    if (length(limits_extras) > 0) {
      stop("facet names in 'panel_limits' not found in 'layout': ",
           paste(sQuote(limits_extras), collapse = ","))
    } else if (length(limits_names) == 0 && NROW(self$panel_limits) == 1) {
      # no panels in 'panel_limits'
      this_panel_limits <- cbind(this_layout, self$panel_limits)
    } else {
      this_panel_limits <- merge(this_layout, self$panel_limits, all.x = TRUE, by = limits_names)
    }

    if (isTRUE(NROW(this_panel_limits) > 1)) {
      stop("multiple matches for current panel in 'panel_limits'")
    }

    # add missing min/max columns, default to "no override" (NA)
    this_panel_limits[, setdiff(c("xmin", "xmax", "ymin", "ymax"),
                                names(this_panel_limits)) ] <- NA

    c(train_cartesian(scale_x, self$limits$x, "x",
                      unlist(this_panel_limits[, c("xmin", "xmax"), drop = TRUE])),
      train_cartesian(scale_y, self$limits$y, "y",
                      unlist(this_panel_limits[, c("ymin", "ymax"), drop = TRUE])))
  }
)

Hi, I found this via Zach Burchill's post after running into errors. Can you explain how to use this if you don't have labels for your facets? Eg. I am using cut_width to split continuous data into groups, and then running facet_grid on the vars() of that output. I have a simple output with only two facets in a single column, but I can't figure out how to identify what the second column name would be in order to run your function and alter the x axis limits... I feel this is a super simple oversight but am hoping you can help!

I don't know that I can do anything without a MWE.

Of course, here is an example of what I am trying to reformat :
#Example code for facet_grid issue
library(ggplot2)
library(cowplot)

set.seed(23)

#create simplified results df
results<- data.frame("total_cost" = c(seq(0,20, length.out=6), 110), "strategies" = c("Baseline", "S01", "S02", "S03", "S04", "S05", "ALL"), "number_of_species" = c(0,2,3,6,7,14,16))

#PlotResults function
PlotResults <- function(summary.results, draw.labels=TRUE){
#Create a plot object from the neat results table
tmp <- summary.results
#scale
tmp$facet<- cut_width(tmp$total_cost, width= 30, boundary = 0, labels=FALSE) # add cut interval for facet wrap of very large x axis range

#Create plot object - add linetype variation by threshold; reduce point size to 2
this.plot <- ggplot(tmp, aes(x=total_cost, y=number_of_species, label=strategies)) +
theme_cowplot() +
facet_grid(cols=vars(facet), scales = "free_x", space = "free_x") + #facet grid to break x axis and allow diff size panels
geom_step() +
geom_point(size=3) +
scale_y_continuous(labels = function (x) floor(x))+
theme(strip.text.x = element_blank()) + #remove facet strip labels
labs(x = "Mean annual cost (million CAD)",
y = "Number of species secured")

if(draw.labels){
this.plot <- this.plot + geom_text(hjust = -0.1, vjust = 0, nudge_y = -0.9, size=3, check_overlap = TRUE) #adjust labels to be above points and not duplicate (i.e. for Baseline)
}

plot(this.plot)
this.plot
}

#Plotting
p<- PlotResults(results)
print(p)

So after running your code, I tried various ways to identify my facets to adjust the panels. None of it works because I cannot correctly identify the second panel (or really either panel). e.g.:

p<- PlotResults(results)
p<- p + coord_cartesian_panels(~facets, xmin = 108, xmax = 110)
p

Error in f(..., self = self) :

facet names in 'panel_limits' not found in 'layout': ‘facets’

This is a brief example but I tried to write it into the Plot_Results function as well, which would be the ideal place for it rather than adding it as a formatting extra after plotting. I tried to identify the plot layers and work with various elements outside of the plot function but couldn't figure out how to determine the name of my facets.

I could probably design a dataset that includes facet names, but I am really hoping to find a way to fix this within the Plot_Results function, as of course this is a simplified example and I want to use the function to plot several different results datasets

I think what I ultimately need is to understand how the naming convention for your function works (perhaps you could provide more examples) so that I can label my temporary dataframe correctly on this line:
tmp$facet<- cut_width(tmp$total_cost, width= 30, boundary = 0, labels=FALSE) # add cut interval for facet wrap of very large x axis range

Hi! I was trying to use this code for setting individual limits for faceted boxplots. I keep receiving errors, and I was thinking it may be because I don't have an x-axis numeric value as I only have categorical data? I am trying to make faceted box plots that are grouped into 6 panels of graphs based on their category. The x-axis will display other categories ('nlcdclassOrder2' in my dataset) to look at trends in abundance ('value' in my dataset-- the y-axis).

I'm looking to change the y-axis only for a graph that looks similar to this:

When trying to use your function, I get this error:

p3 = p2 + coord_cartesian_panels(

• panel_limits = tribble(

•  ~category, ~ymin, ~ymax
  

• , "Actinomycetes" , 0, 150
• ))
  p3
  Error in new_mapped_discrete():
  ! mapped_discrete objects can only be created from numeric vectors

I went back and deleted any scale_x or x-related limits in your function, but then I get this error:

Error in f(..., self = self) : unused argument ()

Here is a sample of my data and the ggplot2 code I was using, if you had time to help:

#Import data plfa_functionalgroups_noNA <- structure(list(value = c(448.49, 226.13, 254.86, 233.83, 210.06, 247.97, 201.97, 257.02, 352.8, 234.26, 204.09, 313.53, 224.05, 227.95, 265.35, 366.5, 203.02, 234.38, 205.12, 230.87, 240.35, 210.13, 201.92, 220.5, 316.52, 240.77, 227.4, 245.93, 218.74, 311.05, 211.11, 291.55, 398.26, 300.64, 229.1, 231.73, 304.84, 291.37, 224.39, 207.34, 211.74, 200.79, 217.13, 206.48, 371.7 ), category = c("GramPOS", "GramPOS", "GramPOS", "GramNEG", "GramNEG", "GramNEG", "AMF", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "GramNEG", "Actinomycetes", "Actinomycetes", "Actinomycetes", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "Saprotroph", "GramNEG"), nlcdClassorder2 = structure(c(2L, 4L, 2L, 4L, 5L, 5L, 2L, 4L, 2L, 2L, 3L, 5L, 5L, 6L, 5L, 5L, 3L, 3L, 3L, 3L, 1L, 6L, 2L, 2L, 2L, 3L, 3L, 3L, 3L, 3L, 3L, 4L, 2L, 4L, 2L, 1L, 2L, 2L, 3L, 6L, 3L, 3L, 3L, 3L, 4L), .Label = c("MF", "DF", "EF", "WW", "DS", "SS"), class = "factor")), row.names = c(48290L, 53126L, 57708L, 86134L, 89240L, 89262L, 90727L, 95412L, 95444L, 95633L, 98234L, 98674L, 98676L, 98677L, 98692L, 98696L, 98700L, 98702L, 98710L, 98719L, 98721L, 98733L, 98752L, 98753L, 98755L, 98864L, 98870L, 98872L, 98890L, 98912L, 98958L, 133148L, 133180L, 133218L, 147331L, 147474L, 147494L, 147520L, 150121L, 150564L, 150589L, 150597L, 150606L, 150799L, 189752L), class = "data.frame")

And the ggplot2 code:
p1 <- ggplot(plfa_functionalgroups_noNA, aes(x=nlcdClassorder2, y=value, fill=nlcdClassorder2), outlier.shape=NA) + geom_boxplot(outlier.shape=NA) + facet_wrap(~category, scales = "free_y")

p2 <- p1 + geom_jitter(aes(fill = nlcdClassorder2), alpha = 0.25, width = 0.3, size = 2, shape = 21, stroke = 0, col ="black") + scale_fill_manual(values=c("#004D40", "#739227", "#0C794A", "#BFB942", "#2A9092", "#4950B1", "#C692DE", "#B7E0C8", "#901058", "#FFF299", "#D1D29F")) + geom_boxplot(aes(col = nlcdClassorder2, fill = nlcdClassorder2, color="black"), alpha = 0.75, outlier.shape = NA, lwd=0.25) + scale_color_manual(values = c("white", "white", "white", "black","black", "white", "black", "black", "white", "black", "black"))

p3 = p2 + coord_cartesian_panels( panel_limits = tribble( ~category, ~ymin, ~ymax , "Actinomycetes" , 0, 150 ))
I was trying to test and see if this function worked with one set of the paneled graphs (Actinomycetes, from the "category" column before passing limits for the other 5 panels)

Thank you very much for your work already!

@LiaChalifour sorry for the late notice, I didn't receive notification a year ago and hadn't looked at this until now.

@ocallahana I'll try to look at it later, cannot do so now.

@r2evans, I have one issue, but this is excellent for the example given, and will benefit many users out there, thank you. I did get this to work with an x- and y-axis that were numeric.

Unfortunately, that's the caveat: it will not work if the x-axis is a factor. In your example data, if we make Nsubjects a factor rather than numeric, we can replicate this situation.

I believe this is the same issue, or one of the same issues, that @ocallahana was having above. In my case my x-axis is years, which is a factor so that I can do a little boxplot per year rather than have all years combine into one big boxplot spanning all years when it's a numeric variable. I've been fiddling with your code for a while and cannot figure out how to adapt it to this particular case. If you have insight on how it might be revised, it would be of great help. Otherwise, I may ask on stackoverflow to see if someone can help. If I have the need, and @ocallahana had the need, there are surely others who would benefit.

Thanks again for putting in this work.

@stanleyrhodes I think I was aware of the possibility of that unintended constraint when writing it, but all of my use-cases involved continuous axes. I don't have bandwidth at the moment to jump into this, my apologies. However, if you find a way to adapt it, I would really appreciate if you could come back and post an update! Even a link to an SO q/a that shows the resolution would be informative.

@r2evans After fiddling around, it the problem appears to start within ggplot2:::view_scale_primary(), which expected limits of a different form from what was passed into it by train_cartesian(). Since view_scale_primary() uses if / else to handle numeric & discrete axes differently, this hasn't materialized until we try to expand usage to cover discrete axis.

I added a line within train-cartesian(), before view_scale_primary() is called, which seems to work for the test cases used in the SO question + what @ocallahana shared above.

Link to my attempt on SO: https://stackoverflow.com/a/75861761/8449629

Thank you for the comment, @linzi-sg! I've edited the gist above to include your suggested line.

@linzi-sg You are a saint! Thanks for your solution and very clear SO answer. And indeed, it does work beautifully for my own situation where I have years as factors rather than numeric so that I can get individual boxplots per year. And thanks again @r2evans for the gist.