From 3097647c0f17a6a7447cf045da603293a153a45b Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 4 Sep 2024 14:33:41 +0200 Subject: [PATCH 1/7] replace `lengths()` with `list_sizes()` --- R/geom-.R | 2 +- R/layer.R | 2 +- 2 files changed, 2 insertions(+), 2 deletions(-) diff --git a/R/geom-.R b/R/geom-.R index 5b6a2af09d..7a576d38d4 100644 --- a/R/geom-.R +++ b/R/geom-.R @@ -264,7 +264,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/layer.R b/R/layer.R index 8acb438c9e..cec564d107 100644 --- a/R/layer.R +++ b/R/layer.R @@ -326,7 +326,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) { From d24c574bed6dae8a285ed98ace180cd693f501ff Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 4 Sep 2024 14:39:13 +0200 Subject: [PATCH 2/7] unname via `vec_set_names()` --- R/layer.R | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/R/layer.R b/R/layer.R index cec564d107..13935427ae 100644 --- a/R/layer.R +++ b/R/layer.R @@ -58,8 +58,8 @@ #' `NA`, the default, includes if any aesthetics are mapped. #' `FALSE` never includes, and `TRUE` always includes. #' It can also be a named logical vector to finely select the aesthetics to -#' display. To include legend keys for all levels, even -#' when no data exists, use `TRUE`. If `NA`, all levels are shown in legend, +#' display. To include legend keys for all levels, even +#' when no data exists, use `TRUE`. If `NA`, all levels are shown in legend, #' but unobserved levels are omitted. #' @param inherit.aes If `FALSE`, overrides the default aesthetics, #' rather than combining with them. This is most useful for helper functions @@ -351,7 +351,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 From fadf24080d8ab8cd169dd8655a22d84fe1189cde Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 4 Sep 2024 15:08:24 +0200 Subject: [PATCH 3/7] add test --- tests/testthat/test-layer.R | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/tests/testthat/test-layer.R b/tests/testthat/test-layer.R index 51f0cd9eee..0501060811 100644 --- a/tests/testthat/test-layer.R +++ b/tests/testthat/test-layer.R @@ -188,3 +188,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) +}) From 9bc6fd5700ca444b81b2c644ce2e28418aa68d97 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 4 Sep 2024 15:12:46 +0200 Subject: [PATCH 4/7] add news bullet --- NEWS.md | 2 ++ 1 file changed, 2 insertions(+) diff --git a/NEWS.md b/NEWS.md index 40bdb3d156..836d1e7670 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,7 @@ # ggplot2 (development version) +* (internal) removed barriers for using 2D structures as aesthetics + (@teunbrand, #4189). * `guide_bins()`, `guide_colourbar()` and `guide_coloursteps()` gain an `angle` argument to overrule theme settings, similar to `guide_axis(angle)` (@teunbrand, #4594). From 2ce3a5047d4cc2587452dfad8bf81fb7fbda7cf3 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Tue, 10 Sep 2024 12:15:24 +0200 Subject: [PATCH 5/7] use slicing as subsetting --- R/layout.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/layout.R b/R/layout.R index 1b578111b2..25a825d558 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 From 0b823b48edf125984326b1ade14b6836abc40a65 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 20 Sep 2024 09:53:16 +0200 Subject: [PATCH 6/7] deduplicate label validation efforts --- R/guide-.R | 5 +++-- R/scale-.R | 15 +-------------- 2 files changed, 4 insertions(+), 16 deletions(-) diff --git a/R/guide-.R b/R/guide-.R index 4cb77ee7bb..fc4891a5b2 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/scale-.R b/R/scale-.R index fd0bbd444f..ac62a9b0f4 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -850,20 +850,7 @@ ScaleContinuous <- ggproto("ScaleContinuous", Scale, 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) { From 661539ae246ffb7af5da6d0e8b8d576f8f2be7c7 Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Fri, 20 Sep 2024 10:18:14 +0200 Subject: [PATCH 7/7] comparise sizes --- R/scale-.R | 2 +- R/utilities.R | 10 ++++++++++ 2 files changed, 11 insertions(+), 1 deletion(-) diff --git a/R/scale-.R b/R/scale-.R index ac62a9b0f4..d9d0ab6bb3 100644 --- a/R/scale-.R +++ b/R/scale-.R @@ -844,7 +844,7 @@ 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 diff --git a/R/utilities.R b/R/utilities.R index 56325e83d9..5a918a21ee 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -843,6 +843,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,