diff --git a/NEWS.md b/NEWS.md index c0097b2de4..fdab50c500 100644 --- a/NEWS.md +++ b/NEWS.md @@ -214,6 +214,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). * `coord_sf()` no longer errors when dealing with empty graticules (@teunbrand, #6052) * Added `theme_transparent()` with transparent backgrounds (@topepo). * New theme elements `palette.{aes}.discrete` and `palette.{aes}.continuous`. diff --git a/R/geom-.R b/R/geom-.R index dae3027e1b..50bdeb66a6 100644 --- a/R/geom-.R +++ b/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)) { diff --git a/R/guide-.R b/R/guide-.R index aa2aa7b37d..c700329cb3 100644 --- a/R/guide-.R +++ b/R/guide-.R @@ -525,11 +525,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) } diff --git a/R/layer.R b/R/layer.R index 639fece4af..d2355a46ba 100644 --- a/R/layer.R +++ b/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 diff --git a/R/layout.R b/R/layout.R index 25088798b1..5954031d20 100644 --- a/R/layout.R +++ b/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 diff --git a/R/scale-.R b/R/scale-.R index 6732e22ba3..53c9f4ee66 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -851,13 +851,14 @@ 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)) { + + if (obj_is_list(labels)) { # Guard against list with empty elements labels[lengths(labels) == 0] <- "" # Make sure each element is scalar @@ -1386,7 +1387,7 @@ scale_flip_position <- function(scale) { } check_transformation <- function(x, transformed, name, arg = NULL, call = NULL) { - if (!any(is.finite(x) != is.finite(transformed))) { + if (!any(is_finite(x) != is_finite(transformed))) { return(invisible()) } if (is.null(arg)) { diff --git a/R/utilities.R b/R/utilities.R index cbb403da4e..54087eba68 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -781,6 +781,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 + } +} + fallback_palette <- function(scale) { aes <- scale$aesthetics[1] discrete <- scale$is_discrete() diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index 964211a4ee..225cedd947 100644 --- a/tests/testthat/test-layer.R +++ b/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) +})