Reimplement S3 <uneval> into S7 <mapping>

Author: teunbrand

NAMESPACE

@@ -3,14 +3,14 @@
 S3method("$","ggplot2::theme")
 S3method("$",ggproto)
 S3method("$",ggproto_parent)
-S3method("$<-",uneval)
+S3method("$<-","ggplot2::mapping")
 S3method("+",gg)
+S3method("[","ggplot2::mapping")
 S3method("[",mapped_discrete)
-S3method("[",uneval)
+S3method("[<-","ggplot2::mapping")
 S3method("[<-",mapped_discrete)
-S3method("[<-",uneval)
 S3method("[[",ggproto)
-S3method("[[<-",uneval)
+S3method("[[<-","ggplot2::mapping")
 S3method(.DollarNames,ggproto)
 S3method(as.data.frame,mapped_discrete)
 S3method(as.list,ggproto)
@@ -66,7 +66,6 @@ S3method(ggplot_add,data.frame)
 S3method(ggplot_add,default)
 S3method(ggplot_add,labels)
 S3method(ggplot_add,list)
-S3method(ggplot_add,uneval)
 S3method(ggplot_build,ggplot)
 S3method(ggplot_build,ggplot_built)
 S3method(ggplot_gtable,ggplot_built)
@@ -105,14 +104,14 @@ S3method(predictdf,default)
 S3method(predictdf,glm)
 S3method(predictdf,locfit)
 S3method(predictdf,loess)
+S3method(print,"ggplot2::mapping")
 S3method(print,element)
 S3method(print,ggplot)
 S3method(print,ggplot2_bins)
 S3method(print,ggproto)
 S3method(print,ggproto_method)
 S3method(print,rel)
 S3method(print,theme)
-S3method(print,uneval)
 S3method(scale_type,Date)
 S3method(scale_type,POSIXt)
 S3method(scale_type,character)

R/aes.R

@@ -46,8 +46,8 @@ NULL
 #' 'AsIs' variables.
 #'
 #' @family aesthetics documentation
-#' @return A list with class `uneval`. Components of the list are either
-#'   quosures or constants.
+#' @return An S7 object representing a list with class `mapping`. Components of
+#'   the list are either quosures or constants.
 #' @export
 #' @examples
 #' aes(x = mpg, y = wt)
@@ -105,13 +105,21 @@ aes <- function(x, y, ...) {
     inject(aes(!!!args))
   })
 
-  aes <- new_aes(args, env = parent.frame())
-  rename_aes(aes)
+  mapping(rename_aes(args), env = parent.frame())
 }
 
+mapping <- S7::new_class(
+  "mapping", parent = S7::new_S3_class("gg"),
+  constructor = function(x, env = globalenv()) {
+    check_object(x, is.list, "a {.cls list}")
+    x <- lapply(x, new_aesthetic, env = env)
+    S7::new_object(x)
+  }
+)
+
 #' @export
 #' @rdname is_tests
-is.mapping <- function(x) inherits(x, "uneval")
+is.mapping <- function(x) S7::S7_inherits(x, mapping)
 
 # Wrap symbolic objects in quosures but pull out constants out of
 # quosures for backward-compatibility
@@ -130,14 +138,9 @@ new_aesthetic <- function(x, env = globalenv()) {
 
   x
 }
-new_aes <- function(x, env = globalenv()) {
-  check_object(x, is.list, "a {.cls list}")
-  x <- lapply(x, new_aesthetic, env = env)
-  structure(x, class = "uneval")
-}
 
 #' @export
-print.uneval <- function(x, ...) {
+`print.ggplot2::mapping` <- function(x, ...) {
   cat("Aesthetic mapping: \n")
 
   if (length(x) == 0) {
@@ -153,25 +156,22 @@ print.uneval <- function(x, ...) {
 }
 
 #' @export
-"[.uneval" <- function(x, i, ...) {
-  new_aes(NextMethod())
+"[.ggplot2::mapping" <- function(x, i, ...) {
+  mapping(NextMethod())
 }
 
 # If necessary coerce replacements to quosures for compatibility
 #' @export
-"[[<-.uneval" <- function(x, i, value) {
-  new_aes(NextMethod())
+"[[<-.ggplot2::mapping" <- function(x, i, value) {
+  mapping(NextMethod())
 }
 #' @export
-"$<-.uneval" <- function(x, i, value) {
-  # Can't use NextMethod() because of a bug in R 3.1
-  x <- unclass(x)
-  x[[i]] <- value
-  new_aes(x)
+"$<-.ggplot2::mapping" <- function(x, i, value) {
+  mapping(NextMethod())
 }
 #' @export
-"[<-.uneval" <- function(x, i, value) {
-  new_aes(NextMethod())
+"[<-.ggplot2::mapping" <- function(x, i, value) {
+  mapping(NextMethod())
 }
 
 #' Standardise aesthetic names
@@ -212,8 +212,7 @@ substitute_aes <- function(x, fun = standardise_aes_symbols, ...) {
   x <- lapply(x, function(aesthetic) {
     as_quosure(fun(quo_get_expr(aesthetic), ...), env = environment(aesthetic))
   })
-  class(x) <- "uneval"
-  x
+  mapping(x)
 }
 # x is a quoted expression from inside aes()
 standardise_aes_symbols <- function(x) {
@@ -311,7 +310,7 @@ aes_ <- function(x, y, ...) {
     }
   }
   mapping <- lapply(mapping, as_quosure_aes)
-  structure(rename_aes(mapping), class = "uneval")
+  mapping(rename_aes(mapping))
 }
 
 #' @rdname aes_
@@ -337,7 +336,7 @@ aes_string <- function(x, y, ...) {
     new_aesthetic(x, env = caller_env)
   })
 
-  structure(rename_aes(mapping), class = "uneval")
+  mapping(rename_aes(mapping))
 }
 
 #' @export
@@ -358,10 +357,7 @@ aes_all <- function(vars) {
 
   # Quosure the symbols in the empty environment because they can only
   # refer to the data mask
-  structure(
-    lapply(vars, function(x) new_quosure(as.name(x), emptyenv())),
-    class = "uneval"
-  )
+  mapping(lapply(vars, function(x) new_quosure(as.name(x), emptyenv())))
 }
 
 #' Automatic aesthetic mapping
@@ -396,7 +392,7 @@ aes_auto <- function(data = NULL, ...) {
     aes <- c(aes, args[names(args) != "data"])
   }
 
-  structure(rename_aes(aes), class = "uneval")
+  mapping(rename_aes(aes))
 }
 
 mapped_aesthetics <- function(x) {

R/layer.R

@@ -213,7 +213,7 @@ validate_mapping <- function(mapping, call = caller_env()) {
   }
 
   # For backward compatibility with pre-tidy-eval layers
-  new_aes(mapping)
+  mapping(mapping)
 }
 
 Layer <- ggproto("Layer", NULL,
@@ -265,7 +265,7 @@ Layer <- ggproto("Layer", NULL,
   setup_layer = function(self, data, plot) {
     # For annotation geoms, it is useful to be able to ignore the default aes
     if (isTRUE(self$inherit.aes)) {
-      self$computed_mapping <- defaults(self$mapping, plot$mapping)
+      self$computed_mapping <- mapping(defaults(self$mapping, plot$mapping))
 
       # Inherit size as linewidth from global mapping
       if (self$geom$rename_size &&
@@ -275,8 +275,6 @@ Layer <- ggproto("Layer", NULL,
         self$computed_mapping$size <- plot$mapping$size
         deprecate_soft0("3.4.0", I("Using `size` aesthetic for lines"), I("`linewidth`"))
       }
-      # defaults() strips class, but it needs to be preserved for now
-      class(self$computed_mapping) <- "uneval"
     } else {
       self$computed_mapping <- self$mapping
     }

R/plot-construction.R

@@ -156,11 +156,8 @@ ggplot_add.Guides <- function(object, plot, object_name) {
   }
   plot
 }
-#' @export
-ggplot_add.uneval <- function(object, plot, object_name) {
-  plot$mapping <- defaults(object, plot$mapping)
-  # defaults() doesn't copy class, so copy it.
-  class(plot$mapping) <- class(object)
+S7::method(ggplot_add, mapping) <- function(object, plot, object_name) {
+  plot$mapping <- mapping(defaults(object, plot$mapping))
   plot
 }
 #' @export

R/quick-plot.R

@@ -78,7 +78,7 @@ qplot <- function(x, y, ..., data, facets = NULL, margins = FALSE,
   is_constant <- (!names(exprs) %in% ggplot_global$all_aesthetics) |
     vapply(exprs, quo_is_call, logical(1), name = "I")
 
-  mapping <- new_aes(exprs[!is_missing & !is_constant], env = parent.frame())
+  mapping <- mapping(exprs[!is_missing & !is_constant], env = parent.frame())
 
   consts <- exprs[is_constant]
 

R/summarise-plot.R

@@ -124,7 +124,7 @@ summarise_coord <- function(p) {
 summarise_layers <- function(p) {
   check_inherits(p, "ggplot_built")
 
-  # Default mappings. Make sure it's a regular list instead of an uneval
+  # Default mappings. Make sure it's a regular list instead of a mapping
   # object.
   default_mapping <- unclass(p$plot$mapping)
 

man/aes.Rd

@@ -54,7 +54,7 @@
 
     Don't know how to get alternative usage for `foo`.
 
-# new_aes() checks its inputs
+# mapping() checks its inputs
 
     `x` must be a <list>, not an integer vector.
 

tests/testthat/_snaps/aes.md

@@ -1,6 +1,6 @@
-# fortify.default proves a helpful error with class uneval
+# fortify.default proves a helpful error with mapping class
 
-    `data` must be a <data.frame>, or an object coercible by `fortify()`, or a valid <data.frame>-like object coercible by `as.data.frame()`, not a <uneval> object.
+    `data` must be a <data.frame>, or an object coercible by `fortify()`, or a valid <data.frame>-like object coercible by `as.data.frame()`, not a <ggplot2::mapping> object.
     i Did you accidentally pass `aes()` to the `data` argument?
 
 # fortify.default can handle healthy data-frame-like objects

tests/testthat/_snaps/fortify.md

@@ -1,4 +1,4 @@
-test_that("mapping class is preserved when adding uneval objects", {
+test_that("mapping class is preserved when adding mapping objects", {
   p <- ggplot(mtcars) + aes(wt, mpg)
-  expect_identical(class(p$mapping), "uneval")
+  expect_s7_class(p$mapping, mapping)
 })