Detect order of applications of transformations from ggplot object

476 Views Asked by At

These objects print the same but the objects themselves are different.

library(ggplot2)
p1 <- ggplot(cars, aes(speed, dist)) + xlim(1, 2) + geom_point() + geom_line()
p2 <- ggplot(cars, aes(speed, dist)) + geom_point() + xlim(1, 2) + geom_line()
p3 <- ggplot(cars, aes(speed, dist)) + geom_point() + geom_line() + xlim(1, 2)
length(waldo::compare(p1, p2))
#> [1] 229
length(waldo::compare(p1, p3))
#> [1] 190

I would like to understand from a ggplot object itself the order in which the transformations have been applied.

We can access the layers, scales etc using p1$layers, p1$scales etc, and we can find them there in order of appliance by transformation type, but I need to know the order overall.

$layers elements are equivalent between the plots above (as can be checked with waldo::compare(p1$layers, p2$layers), $scales element however differ due to environments found as attributes, function enclosures, or elements of other environments. This is the part I got stuck at.

A general answer is best, but an answer that will work "90% of the time" would be appreciated too. The general issue is not only about scales and layers but should include other transformations as well (coordinates, position, themes) as long as their position relative to objects of other types changes the output.

The output for the given examples might look like :

# 1st scale than 1st layer then 2nd layer
gg_order(p1)
#> scales layers layers 
#>      1      1      2

# 1st layer than 1st scale then 2nd layer
gg_order(p2)
#> layers scales layers 
#>      1      1      2

# 1st layer than 2nd layer then 1st scale
gg_order(p3)
#> layers layers scales 
#>      1      2      1

The number of transformations doesn't always match number of functions in the original code since a few functions apply several transformations, we can assume a one on one mapping here if it helps.

EDIT:

I have designed some tools that help navigating the waldo diffs, this might help:

devtools::install_github("moodymudskipper/woof")
woof::woof_compare(p1, p2)
w <- woof::woof_compare(p1, p2)
w$scales$super$..env$env$self$super$..env
print(w$scales$super$..env$env$self$super$..env, substitute = TRUE)
2

There are 2 best solutions below

3
teunbrand On

This isn't an answer in the sense that this will help you further your goal, but perhaps it might help you scope out a different goal.

The reason that waldo is reporting differences between these plots, is because upon addition of every layer, the scales are cloned: the new scales become child environments of the old scales. The 'state' of the plot object, should thus depend on how many objects were added after the xlim() function, because this operation clones the scale that the function produces. The cloning happens in this line of source code:

https://github.com/tidyverse/ggplot2/blob/d7f22413efea3dd2a7c9effff05d4b2aa2c2d300/R/plot.R#L150

I believe this scale cloning is what lets waldo report differences, but I don't think the cloning is able to track any state in other parts of the plot, and therefore your goal might be unachievable.

The reason I believe so, is because one can do the following exercise. If you fork ggplot2, then comment out that particular line, those plot objects become identical (but won't render properly):

library(ggplot2) # 3.4.2 from CRAN

p1 <- ggplot(cars, aes(speed, dist)) + xlim(1, 2) + geom_point() + geom_line()
p2 <- ggplot(cars, aes(speed, dist)) + geom_point() + xlim(1, 2) + geom_line()
p3 <- ggplot(cars, aes(speed, dist)) + geom_point() + geom_line() + xlim(1, 2)

length(waldo::compare(p1, p2))
#> [1] 224
length(waldo::compare(p1, p3))
#> [1] 190

# Now with local fork with that line commented out
# Path may differ on your machine
devtools::load_all("~/packages/ggplot2/")
#> ℹ Loading ggplot2

p1 <- ggplot(cars, aes(speed, dist)) + xlim(1, 2) + geom_point() + geom_line()
p2 <- ggplot(cars, aes(speed, dist)) + geom_point() + xlim(1, 2) + geom_line()
p3 <- ggplot(cars, aes(speed, dist)) + geom_point() + geom_line() + xlim(1, 2)

waldo::compare(p1, p2)
#> ✔ No differences
waldo::compare(p1, p3)
#> ✔ No differences

Created on 2023-04-08 with reprex v2.0.2

So unless one is really an R wizard and are able to wrangle out different states from these scale environments, I think the order of operations is irretrievable from the plot object alone.

I'd be happy to be proven wrong though!

5
Z.Lin On

Edited at the end to discuss ggnewscale & ggh4x examples.

I played around to see if one can "flatten" the multi-layered scales component of a regular ggplot object, and came up with the following:

flatten.scales <- function(gg) {
  
  # take stock how many different scales are contained within the top-level 
  # scale list, & sort their names alphabetically for consistency
  orig.scales <- gg[["scales"]]
  scale.count <- orig.scales$n()
  scale.aesthetics <- lapply(seq_len(scale.count),
                             function(i) orig.scales$scales[[i]]$aesthetics)
  names(scale.aesthetics) <- lapply(scale.aesthetics,
                                    function(x) x[[1]])
  scale.names.sorted <- sort(names(scale.aesthetics))

  # define a new empty scale list ggproto object
  new.scales <- ggplot2:::scales_list()

  # for each scale, traverse up its inheritance tree until we can't go any
  # higher without losing the function call -- i.e. any super's beyond this
  # point are inheritances defined in ggproto (e.g. ScaleContinuousPosition 
  # inherits from ScaleContinuous, which in turn inherits from Scale), not
  # inheritances created during cloning of scales within this ggplot object.
  # add that scale to the new scale list.
  for(i in seq_along(scale.names.sorted)) {
    scale.to.add <- orig.scales$get_scales(scale.names.sorted[[i]])
    while("super" %in% names(scale.to.add)) {
      scale.to.add1 <- scale.to.add$super()
      if(!is.null(scale.to.add1$call)) {
        scale.to.add <- scale.to.add1
      } else {
        break
      }
    }

    # added step to handle ggnewscale, as the top-level scale's aesthetic would
    # have lost the "XXX_new" format & lead to clash with another scale with
    # aesthetic name = "XXX". also keep use of the original guide (which includes
    # the renamed aesthetic under available_aes)
    if(!scale.names.sorted[[i]] %in% scale.to.add$aesthetics) {
      scale.to.add$aesthetics <- scale.names.sorted[[i]]
      scale.to.add$guide <- scale.guide
    }

    new.scales$add(scale.to.add)
  }
  
  gg[["scales"]] <- new.scales
  return(gg)
}

This won't return the order of the layers, but comparing two ggplot objects with flattened scales would allow one to ignore layer order differences, so that only other, presumably more serious differences are reported for the user's attention.

Demonstration with a variation on the original example

p1 <- ggplot(cars, aes(speed, dist)) + xlim(3, 26) + ylim(25, 100) + geom_point() + geom_line()
p2 <- ggplot(cars, aes(speed, dist)) + ylim(25, 100) + xlim(3, 26) + geom_point() + geom_line()
p3 <- ggplot(cars, aes(speed, dist)) + geom_point() + xlim(3, 26) + geom_line() + ylim(25, 100)
p4 <- ggplot(cars, aes(speed, dist)) + geom_point() + ylim(25, 100) + geom_line() + xlim(3, 26)

length(waldo::compare(p1, p2)) #  22
length(waldo::compare(p1, p3)) # 414
length(waldo::compare(p1, p4)) # 414
length(waldo::compare(p2, p3)) # 414
length(waldo::compare(p2, p4)) # 414
length(waldo::compare(p3, p4)) #  22

waldo::compare(flatten.scales(p1), flatten.scales(p2)) # No differences
waldo::compare(flatten.scales(p1), flatten.scales(p3)) # No differences
waldo::compare(flatten.scales(p1), flatten.scales(p4)) # No differences
waldo::compare(flatten.scales(p2), flatten.scales(p3)) # No differences
waldo::compare(flatten.scales(p2), flatten.scales(p4)) # No differences
waldo::compare(flatten.scales(p3), flatten.scales(p4)) # No differences

library(patchwork)
(p1 | p2 | p3 | p4) / (flatten.scales(p1) | flatten.scales(p2) | flatten.scales(p3) | flatten.scales(p4))
# confirm that the original plots & their variations with flattened scales all
# look identical to one another

A more convoluted example with categorical & non-position scales, plus facets thrown in for good measure:

p1 <- ggplot(mpg, aes(hwy, class, fill = class)) + 
  ylim(c("suv", "midsize", "compact")) +
  geom_boxplot(outlier.shape = NA) + 
  geom_jitter(width = 0.2) + 
  xlim(c(0, 35)) + 
  facet_wrap(vars(fl)) + 
  scale_fill_brewer(palette = "Set2")

p2 <- ggplot(mpg, aes(hwy, class, fill = class)) +
  xlim(c(0, 35)) + 
  geom_boxplot(outlier.shape = NA) + 
  scale_fill_brewer(palette = "Set2") +
  facet_wrap(vars(fl)) + 
  ylim(c("suv", "midsize", "compact")) +
  geom_jitter(width = 0.2) 

length(waldo::compare(p1, p2))                         # 623
waldo::compare(flatten.scales(p1), flatten.scales(p2)) # No differences
(p1 | p2) / (flatten.scales(p1) | flatten.scales(p2))  # Identical aside from random jittering

ggnewscale

The ggnewscale package provides functions of the form new_scale_xxx() to allow subsequent layers to follow a different scale definition. (Somewhat confusingly, the original scale's aesthetic is named "XXX_new" while the new version is named "XXX".) I've updated the code for flatten.scales above by inserting a check for any difference in aesthetic name before adding each flattened scale to the scale list. If there's a difference (presumably due to ggnewscale, because so far I'm not aware of other packages that do this), the original scale's aesthetic name & guide are retained.

Demonstration

library(ggnewscale)
library(ggplot2)

# generate data
set.seed(123)
topography <- expand.grid(x = 1:nrow(volcano), y = 1:ncol(volcano))
topography$z <- c(volcano)
measurements <- data.frame(x = runif(30, 1, 80),
                           y = runif(30, 1, 60),
                           thing = rnorm(30))

p1 <- ggplot(mapping = aes(x, y)) +
  xlim(10, 70) +
  geom_contour(data = topography, aes(z = z, color = after_stat(level))) +
  scale_color_viridis_c(option = "D") +
  new_scale_color() +
  geom_point(data = measurements, size = 3, aes(color = thing)) +
  scale_color_viridis_c(option = "A") +
  labs(x = "HWY", y = "CLASS", colour = "Thing", colour_new = "Level") +
  ylim(10, 50)

p2 <- ggplot(mapping = aes(x, y)) +
  ylim(10, 50) +
  geom_contour(data = topography, aes(z = z, color = after_stat(level))) +
  scale_color_viridis_c(option = "D") +
  new_scale_color() +
  xlim(10, 70) +
  geom_point(data = measurements, size = 3, aes(color = thing)) +
  scale_color_viridis_c(option = "A") +
  labs(x = "HWY", y = "CLASS", colour = "Thing", colour_new = "Level")

length(waldo::compare(p1, p2))                         # 409
waldo::compare(flatten.scales(p1), flatten.scales(p2)) # No differences
(p1 | p2) / (flatten.scales(p1) | flatten.scales(p2))  # Identical

ggh4x

The ggh4x package provides functions of the form scale_xxx_multi() to allow multiple scales to be mapped to colour / fill. Like the ggnewscale case, order of layers matter, because scale_xxx_multi() affects all earlier layers that make use of relevant aesthetic mappings, by making changes to their innards.

Hence, the situation is rather more complex because even after flatten.scales() scrubs through the scales, the layers component of the ggplot object contain remnants of the original scales present when scale_xxx_multi() took effect.

Demonstration

library(ggh4x)

p1 <- ggplot(iris, aes(Sepal.Width, Sepal.Length)) +
  geom_point(aes(swidth = Sepal.Width),
             data = ~ subset(., Species == "setosa")) +
  geom_point(aes(pleng = Petal.Length),
             data = ~ subset(., Species == "versicolor")) +
  scale_y_continuous(name = "Assorted measurements") +
  geom_point(aes(pwidth = Petal.Width),
             data = ~ subset(., Species == "virginica")) +
  facet_wrap(~ Species, scales = "free_x") + 
  scale_colour_multi(
    aesthetics = c("swidth", "pleng", "pwidth"),
    colours = list(c("black", "green"), c("gray",  "red"), c("white", "blue")),
    guide = list(guide_colourbar(barheight = unit(35, "pt")))
  )

p2 <- ggplot(iris, aes(Sepal.Width, Sepal.Length))  +
  geom_point(aes(swidth = Sepal.Width),
             data = ~ subset(., Species == "setosa")) +
  geom_point(aes(pleng = Petal.Length),
             data = ~ subset(., Species == "versicolor")) +
  geom_point(aes(pwidth = Petal.Width),
             data = ~ subset(., Species == "virginica")) +
  facet_wrap(~ Species, scales = "free_x") +
  scale_colour_multi(
    aesthetics = c("swidth", "pleng", "pwidth"),
    colours = list(c("black", "green"), c("gray",  "red"), c("white", "blue")),
    guide = list(guide_colourbar(barheight = unit(35, "pt")))
  ) +
  scale_y_continuous(name = "Assorted measurements")

length(waldo::compare(p1, p2)) # 876
for(i in seq_along(p1)) {
  cat(i, "(", names(p1)[i], ") :")
  res <- waldo::compare(p1[[i]], p2[[i]])
  if(length(res) == 0) {
    cat("No diff")
  } else {
    cat(length(res))
  }
  cat("\n")
}
# 1 ( data ) :No diff
# 2 ( layers ) :232
# 3 ( scales ) :644
# 4 ( mapping ) :No diff
# 5 ( theme ) :No diff
# 6 ( coordinates ) :No diff
# 7 ( facet ) :No diff
# 8 ( plot_env ) :No diff
# 9 ( labels ) :No diff
# p1 & p2 differ in layers & scales

p1.flattened <- flatten.scales(p1)
p2.flattened <- flatten.scales(p2)
for(i in seq_along(p1)) {
  cat(i, "(", names(p1)[i], ") :")
  res <- waldo::compare(p1.flattened[[i]], p2.flattened[[i]])
  if(length(res) == 0) {
    cat("No diff")
  } else {
    cat(length(res))
  }
  cat("\n")
}
# 1 ( data ) :No diff
# 2 ( layers ) :232
# 3 ( scales ) :No diff
# 4 ( mapping ) :No diff
# 5 ( theme ) :No diff
# 6 ( coordinates ) :No diff
# 7 ( facet ) :No diff
# 8 ( plot_env ) :No diff
# 9 ( labels ) :No diff
# flattened versions of p1 & p2 still differ in layers

cowplot::plot_grid(p1, p1.flattened, p2, p2.flattened, nrow = 2)
# but at least everything still looks identical
# (cowplot used to arrange the plots, as patchwork complained)

If we peer into waldo::compare(p1.flattened[["layers"]], p2.flattened[["layers"]]) (or equivalently waldo::compare(p1[["layers"]], p2[["layers"]]), since the function didn't do anything with the layers component), we get various messages such as:

`parent.env(environment(old[[1]]$geom$draw_key))$.GenericCallEnv$p$scales$scales` is length 4
`parent.env(environment(new[[1]]$geom$draw_key))$.GenericCallEnv$p$scales$scales` is length 3

...

`parent.env(environment(old[[1]]$geom$draw_key))$.GenericCallEnv$p$scales$scales[[1]]` is length 2
`parent.env(environment(new[[1]]$geom$draw_key))$.GenericCallEnv$p$scales$scales[[1]]` is length 19

(omitted)

While it's probably possible to write another function that scrubs through the environments to remove the offending elements (which appears to be copies of the original plot with scales in a particular order), I hesitate to do so for two reasons:

  1. Based on my understanding, these environments are not unique to each ggplot object. I.e. suppose we have a function scrub.layers() that performs the task, whatever happens in p1.new = scrub.layers(p1) will affect the original p1, since they reference the same environments.

  2. I'm not that good with environments & haven't managed to come up with a viable solution after two days of trying. (I did manage to increase my exposure to a fascinating variety of error messages though :P).

That said, waldo::compare does have an option to ignore comparisons within environments of functions, if that's a viable option for you:

length(waldo::compare(p1, p2)) # 876
length(waldo::compare(flatten.scales(p1), flatten.scales(p2))) # 232
length(waldo::compare(p1, p2, ignore_function_env = TRUE)) # 77
length(waldo::compare(flatten.scales(p1), flatten.scales(p2), ignore_function_env = TRUE)) # 0

TL;DR: If it's okay to not compare environments, flatten.scales should work for ggh4x's scale_xxx_multi -- subject to further stress tests based on actual use cases, that is.