Skip to content

Enable 2D structures as aesthetics #6076

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Merged
merged 12 commits into from
Dec 3, 2024
2 changes: 2 additions & 0 deletions NEWS.md
Original file line number Diff line number Diff line change
Expand Up @@ -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`.
Expand Down
2 changes: 1 addition & 1 deletion R/geom-.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)) {
Expand Down
5 changes: 3 additions & 2 deletions R/guide-.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
}
Expand Down
4 changes: 2 additions & 2 deletions R/layer.R
Original file line number Diff line number Diff line change
Expand Up @@ -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) {
Expand All @@ -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
Expand Down
2 changes: 1 addition & 1 deletion R/layout.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
7 changes: 4 additions & 3 deletions R/scale-.R
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down Expand Up @@ -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)) {
Expand Down
10 changes: 10 additions & 0 deletions R/utilities.R
Original file line number Diff line number Diff line change
Expand Up @@ -781,6 +781,16 @@
x
}

size0 <- function(x) {
if (obj_is_vector(x)) {
vec_size(x)
} else if (is.vector(x)) {
length(x)
} else {
NULL

Check warning on line 790 in R/utilities.R

View check run for this annotation

Codecov / codecov/patch

R/utilities.R#L790

Added line #L790 was not covered by tests
}
}

fallback_palette <- function(scale) {
aes <- scale$aesthetics[1]
discrete <- scale$is_discrete()
Expand Down
17 changes: 17 additions & 0 deletions tests/testthat/test-layer.R
Original file line number Diff line number Diff line change
Expand Up @@ -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)
})
Loading