resolve merge conflict

Merge branch 'main' into S7_objects

# Conflicts:
#	tests/testthat/test-layer.R

Author: teunbrand

R/facet-grid-.R

@@ -187,7 +187,7 @@ facet_grid <- function(rows = NULL, cols = NULL, scales = "fixed",
   facets_list <- grid_as_facets_list(rows, cols)
 
   # Check for deprecated labellers
-  check_labeller(labeller)
+  labeller <- validate_labeller(labeller)
 
   ggproto(NULL, FacetGrid,
     shrink = shrink,

R/facet-wrap.R

@@ -188,7 +188,7 @@ facet_wrap <- function(facets, nrow = NULL, ncol = NULL, scales = "fixed",
   )
 
   # Check for deprecated labellers
-  check_labeller(labeller)
+  labeller <- validate_labeller(labeller)
 
   # Flatten all facets dimensions into a single one
   facets <- compact_facets(facets)

R/labeller.R

@@ -578,13 +578,13 @@ assemble_strips <- function(grobs, theme, horizontal = TRUE, clip) {
 }
 
 # Reject old school labeller
-check_labeller <- function(labeller) {
+validate_labeller <- function(labeller) {
 
   labeller <- match.fun(labeller)
   is_deprecated <- all(c("variable", "value") %in% names(formals(labeller)))
 
   if (!is_deprecated) {
-    return(invisible())
+    return(labeller)
   }
 
   lifecycle::deprecate_stop(

R/scale-.R

@@ -1311,7 +1311,10 @@ ScaleDiscrete <- ggproto("ScaleDiscrete", Scale,
       pal <- vec_set_names(pal, NULL)
       limits <- pal_names
     }
-    pal <- vec_c(pal, na_value)
+
+    # vec_c is too strict in some cases, but we do want to allow 2D structures
+    pal <- if (is.null(dim(pal))) c(pal, na_value) else vec_c(pal, na_value)
+
     pal_match <-
       vec_slice(pal, match(as.character(x), limits, nomatch = vec_size(pal)))
 

R/scale-colour.R

@@ -298,18 +298,14 @@ scale_backward_compatibility <- function(..., scale, aesthetic, type) {
     scale <- scale %||% fallback
   }
 
-  if (is_bare_string(scale)) {
-    if (scale == "continuous") {
-      scale <- "gradient"
-    }
-    if (scale == "discrete") {
-      scale <- "hue"
-    }
-    if (scale == "viridis") {
-      scale <- switch(
-        type, discrete = "viridis_d", binned = "viridis_b", "viridis_c"
-      )
-    }
+  if (is_bare_string(scale) || is.null(scale)) {
+    scale <- switch(
+      scale %||% type,
+      discrete = "hue",
+      viridis = switch(type, discrete = "viridis_d", binned = "viridis_b", "viridis_c"),
+      continuous = "gradient",
+      scale
+    )
 
     candidates <- paste("scale", aesthetic, scale, sep = "_")
     for (candi in candidates) {

R/theme.R

@@ -998,7 +998,7 @@ combine_elements <- function(e1, e2) {
 
   # If e2 is 'richer' than e1, fill e2 with e1 parameters
   is_subclass <- !any(inherits(e2, class(e1), which = TRUE) == 0)
-  is_subclass <- is_subclass && length(setdiff(class(e2), class(e1)) > 0)
+  is_subclass <- is_subclass && length(setdiff(class(e2), class(e1))) > 0
   if (is_subclass) {
     new <- defaults(S7::props(e1), S7::props(e2))
     S7::props(e2)[names(new)] <- new

tests/testthat/test-labellers.R

@@ -1,3 +1,11 @@
+test_that("facets convert labeller to function", {
+  f <- facet_grid(foo ~ bar, labeller = "label_both")
+  expect_type(f$params$labeller, "closure")
+
+  f <- facet_wrap(foo ~ bar, labeller = "label_value")
+  expect_type(f$params$labeller, "closure")
+})
+
 test_that("label_bquote has access to functions in the calling environment", {
   labels <- data.frame(lab = letters[1:2])
   attr(labels, "facet") <- "wrap"

tests/testthat/test-layer.R

@@ -148,10 +148,10 @@ test_that("layer warns for constant aesthetics", {
 test_that("layer names can be resolved", {
 
   p <- ggplot() + geom_point() + geom_point()
-  expect_equal(names(p@layers), c("geom_point", "geom_point...2"))
+  expect_named(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"))
+  expect_named(p@layers, c("foo", "bar"))
 
   l <- geom_point(name = "foobar")
   expect_snapshot(p + l + l, error = TRUE)