Enable 2D structures as aesthetics

NEWS.md

@@ -189,6 +189,8 @@
   `labs()` and several guides (@teunbrand, #3196).
 * `stat_summary_bin()` no longer ignores `width` parameter (@teunbrand, #4647).
 * Added `keep.zeroes` argument to `stat_bin()` (@teunbrand, #3449)
+* (internal) removed barriers for using 2D structures as aesthetics 
+  (@teunbrand, #4189).
 
 # ggplot2 3.5.1
 

R/geom-.R

@@ -270,7 +270,7 @@ NULL
 .stroke <- 96 / 25.4
 
 check_aesthetics <- function(x, n) {
-  ns <- lengths(x)
+  ns <- list_sizes(x)
   good <- ns == 1L | ns == n
 
   if (all(good)) {

R/guide-.R

@@ -530,11 +530,12 @@ opposite_position <- function(position) {
 
 # Ensure that labels aren't a list of expressions, but proper expressions
 validate_labels <- function(labels) {
-  if (!is.list(labels)) {
+  if (!obj_is_list(labels)) {
     return(labels)
   }
+  labels[lengths(labels) == 0L] <- ""
   if (any(vapply(labels, is.language, logical(1)))) {
-    do.call(expression, labels)
+    inject(expression(!!!labels))
   } else {
     unlist(labels)
   }

R/layer.R

@@ -327,7 +327,7 @@ Layer <- ggproto("Layer", NULL,
     }
 
     n <- nrow(data)
-    aes_n <- lengths(evaled)
+    aes_n <- list_sizes(evaled)
     if (n == 0) {
       # No data, so look at longest evaluated aesthetic
       if (length(evaled) == 0) {
@@ -352,7 +352,7 @@ Layer <- ggproto("Layer", NULL,
     } else {
       evaled$PANEL <- data$PANEL
     }
-    evaled <- lapply(evaled, unname)
+    evaled <- lapply(evaled, vec_set_names, names = NULL)
     evaled <- as_gg_data_frame(evaled)
     evaled <- add_group(evaled)
     evaled

R/layout.R

@@ -318,7 +318,7 @@ scale_apply <- function(data, vars, method, scale_id, scales) {
 
   lapply(vars, function(var) {
     pieces <- lapply(seq_along(scales), function(i) {
-      scales[[i]][[method]](data[[var]][scale_index[[i]]])
+      scales[[i]][[method]](vec_slice(data[[var]], scale_index[[i]]))
     })
     # Remove empty vectors to avoid coercion issues with vctrs
     pieces[lengths(pieces) == 0] <- NULL

R/scale-.R

@@ -850,26 +850,13 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale,
       labels <- self$labels
     }
 
-    if (length(labels) != length(breaks)) {
+    if (!identical(size0(labels), size0(breaks))) {
       cli::cli_abort(
         "{.arg breaks} and {.arg labels} have different lengths.",
         call = self$call
       )
     }
-    if (is.list(labels)) {
-      # Guard against list with empty elements
-      labels[lengths(labels) == 0] <- ""
-      # Make sure each element is scalar
-      labels <- lapply(labels, `[`, 1)
-
-      if (any(vapply(labels, is.language, logical(1)))) {
-        labels <- inject(expression(!!!labels))
-      } else {
-        labels <- unlist(labels)
-      }
-    }
-
-    labels
+    validate_labels(labels)
   },
 
   clone = function(self) {

R/utilities.R

@@ -777,6 +777,16 @@ as_unordered_factor <- function(x) {
   x
 }
 
+size0 <- function(x) {
+  if (obj_is_vector(x)) {
+    vec_size(x)
+  } else if (is.vector(x)) {
+    length(x)
+  } else {
+    NULL
+  }
+}
+
 warn_dots_used <- function(env = caller_env(), call = caller_env()) {
   check_dots_used(
     env = env, call = call,

tests/testthat/test-layer.R

@@ -182,3 +182,20 @@ test_that("layer_data returns a data.frame", {
   l <- geom_point(data = nrow)
   expect_snapshot_error(l$layer_data(mtcars))
 })
+
+test_that("data.frames and matrix aesthetics survive the build stage", {
+  df <- data_frame0(
+    x = 1:2,
+    g = matrix(1:4, 2),
+    f = data_frame0(a = 1:2, b = c("c", "d"))
+  )
+
+  p <- layer_data(
+    ggplot(df, aes(x, x, colour = g, shape = f)) +
+      geom_point() +
+      scale_colour_identity() +
+      scale_shape_identity()
+  )
+  expect_vector(p$colour, matrix(NA_integer_, nrow = 0, ncol = 2), size = 2)
+  expect_vector(p$shape,  data_frame0(a = integer(), b = character()), size = 2)
+})