Merge branch 'main' into wrap_space

Author: teunbrand

NEWS.md

@@ -2,6 +2,8 @@
 
 * `facet_wrap()` can have `space = "free_x"` with 1-row layouts and 
   `space = "free_y"` with 1-column layouts (@teunbrand)
+* Secondary axes respect `n.breaks` setting in continuous scales (@teunbrand, #4483).
+* 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/axis-secondary.R

@@ -188,7 +188,13 @@ AxisSecondary <- ggproto("AxisSecondary", NULL,
       if (scale$is_discrete()) {
         self$breaks <- scale$get_breaks()
       } else {
-        self$breaks <- scale$get_transformation()$breaks
+        breaks <- scale$get_transformation()$breaks
+        n_breaks <- scale$n.breaks
+        if (!is.null(n_breaks) && "n" %in% fn_fmls_names(breaks)) {
+          self$breaks <- function(x) breaks(x, n = n_breaks)
+        } else {
+          self$breaks <- breaks
+        }
       }
     }
     if (is.derived(self$labels)) self$labels <- scale$labels

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", {

tests/testthat/test-sec-axis.R

@@ -400,3 +400,22 @@ test_that("discrete scales can have secondary axes", {
   expect_equal(y$.value, c(1.5, 2.5), ignore_attr = TRUE)
   expect_equal(y$.label, c("grault", "garply"))
 })
+
+test_that("n.breaks is respected by secondary axes (#4483)", {
+
+  b <- ggplot_build(
+    ggplot(data.frame(x = c(0, 10)), aes(x, x)) +
+      scale_y_continuous(
+        n.breaks = 11,
+        sec.axis = sec_axis(~.x*100)
+      )
+  )
+
+  # We get scale breaks via guide data
+  prim <- get_guide_data(b, "y")
+  sec  <- get_guide_data(b, "y.sec")
+
+  expect_equal(prim$.value, sec$.value) # .value is in primary scale
+  expect_equal(prim$.label, as.character(seq(0, 10, length.out = 11)))
+  expect_equal(sec$.label,  as.character(seq(0, 1000, length.out = 11)))
+})