Layers have names (#5967)

* use `%||%` for `na.rm`

* simplify special `key_glyph` case

* add `name` field to LayerInstance objects

* helper for layer names

* apply layer names

* add tests

* add bullet

* fallback for direct `layer()` calls

Author: teunbrand

NEWS.md

@@ -1,5 +1,6 @@
 # ggplot2 (development version)
 
+* Layers can have names (@teunbrand, #4066).
 * (internal) improvements to `pal_qualitative()` (@teunbrand, #5013)
 * `coord_radial(clip = "on")` clips to the panel area when the graphics device
   supports clipping paths (@teunbrand, #5952).

R/layer.R

@@ -130,24 +130,16 @@ layer <- function(geom = NULL, stat = NULL,
   position <- check_subclass(position, "Position", env = parent.frame(), call = call_env)
 
   # Special case for na.rm parameter needed by all layers
-  if (is.null(params$na.rm)) {
-    params$na.rm <- FALSE
-  }
-
-  # Special case for key_glyph parameter which is handed in through
-  # params since all geoms/stats forward ... to params
-  if (!is.null(params$key_glyph)) {
-    key_glyph <- params$key_glyph
-    params$key_glyph <- NULL # remove to avoid warning about unknown parameter
-  }
+  params$na.rm <- params$na.rm %||% FALSE
 
   # Split up params between aesthetics, geom, and stat
   params <- rename_aes(params)
   aes_params  <- params[intersect(names(params), geom$aesthetics())]
   geom_params <- params[intersect(names(params), geom$parameters(TRUE))]
   stat_params <- params[intersect(names(params), stat$parameters(TRUE))]
 
-  all <- c(geom$parameters(TRUE), stat$parameters(TRUE), geom$aesthetics())
+  ignore <- c("key_glyph", "name")
+  all <- c(geom$parameters(TRUE), stat$parameters(TRUE), geom$aesthetics(), ignore)
 
   # Take care of plain patterns provided as aesthetic
   pattern <- vapply(aes_params, is_pattern, logical(1))
@@ -181,9 +173,9 @@ layer <- function(geom = NULL, stat = NULL,
   }
 
   # adjust the legend draw key if requested
-  geom <- set_draw_key(geom, key_glyph)
+  geom <- set_draw_key(geom, key_glyph %||% params$key_glyph)
 
-  fr_call <- layer_class$constructor %||% frame_call(call_env)
+  fr_call <- layer_class$constructor %||% frame_call(call_env) %||% current_call()
 
   ggproto("LayerInstance", layer_class,
     constructor = fr_call,
@@ -196,7 +188,8 @@ layer <- function(geom = NULL, stat = NULL,
     aes_params = aes_params,
     position = position,
     inherit.aes = inherit.aes,
-    show.legend = show.legend
+    show.legend = show.legend,
+    name = params$name
   )
 }
 

R/plot-construction.R

@@ -186,6 +186,25 @@ ggplot_add.by <- function(object, plot, object_name) {
 
 #' @export
 ggplot_add.Layer <- function(object, plot, object_name) {
+  layers_names <- new_layer_names(object, names(plot$layers))
   plot$layers <- append(plot$layers, object)
+  names(plot$layers) <- layers_names
   plot
 }
+
+new_layer_names <- function(layer, existing) {
+  new_name <- layer$name
+  if (is.null(new_name)) {
+    # Construct a name from the layer's call
+    new_name <- call_name(layer$constructor)
+
+    if (new_name %in% existing) {
+      names <- c(existing, new_name)
+      names <- vec_as_names(names, repair = "unique", quiet = TRUE)
+      new_name <- names[length(names)]
+    }
+  }
+
+  names <- c(existing, new_name)
+  vec_as_names(names, repair = "check_unique")
+}

tests/testthat/test-layer.R

@@ -138,6 +138,22 @@ test_that("layer warns for constant aesthetics", {
   expect_snapshot_warning(ggplot_build(p))
 })
 
+test_that("layer names can be resolved", {
+
+  p <- ggplot() + geom_point() + geom_point()
+  expect_equal(names(p$layers), c("geom_point", "geom_point...2"))
+
+  p <- ggplot() + geom_point(name = "foo") + geom_point(name = "bar")
+  expect_equal(names(p$layers), c("foo", "bar"))
+
+  l <- geom_point(name = "foobar")
+  expect_error(
+    p + l + l,
+    "names are duplicated"
+  )
+})
+
+
 # Data extraction ---------------------------------------------------------
 
 test_that("AsIs data passes unmodified", {