From f5bb414c8baa2e9b42c771061a242bf784633c32 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 22:23:12 +0200 Subject: [PATCH 1/8] AsIs has no scale type --- R/scale-type.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/scale-type.R b/R/scale-type.R index d8d4a70b6f..c05c172477 100644 --- a/R/scale-type.R +++ b/R/scale-type.R @@ -68,7 +68,7 @@ scale_type.default <- function(x) { scale_type.list <- function(x) "identity" #' @export -scale_type.AsIs <- function(x) "identity" +scale_type.AsIs <- function(x) NULL #' @export scale_type.logical <- function(x) "discrete" From 43761192aaad15ec06d05aa9bd6110fb3d382172 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 22:23:43 +0200 Subject: [PATCH 2/8] Non-position scales ignore AsIs --- R/scales-.R | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/R/scales-.R b/R/scales-.R index 73c490c8a2..4320554954 100644 --- a/R/scales-.R +++ b/R/scales-.R @@ -65,17 +65,18 @@ ScalesList <- ggproto("ScalesList", NULL, if (empty(df) || length(self$scales) == 0) { return() } - lapply(self$scales, function(scale) scale$train_df(df = df)) + ignore <- vapply(df, inherits, what = "AsIs", logical(1)) + lapply(self$scales, function(scale) scale$train_df(df = df[!ignore])) }, map_df = function(self, df) { if (empty(df) || length(self$scales) == 0) { return(df) } - + ignore <- vapply(df, inherits, what = "AsIs", logical(1)) mapped <- unlist(lapply( self$scales, - function(scale) scale$map_df(df = df) + function(scale) scale$map_df(df = df[!ignore]) ), recursive = FALSE) data_frame0(!!!mapped, df[setdiff(names(df), names(mapped))]) @@ -98,9 +99,10 @@ ScalesList <- ggproto("ScalesList", NULL, return(df) } + ignore <- vapply(df, inherits, what = "AsIs", logical(1)) transformed <- unlist(lapply( scales, - function(scale) scale$transform_df(df = df) + function(scale) scale$transform_df(df = df[!ignore]) ), recursive = FALSE) data_frame0(!!!transformed, df[setdiff(names(df), names(transformed))]) @@ -122,10 +124,11 @@ ScalesList <- ggproto("ScalesList", NULL, return(df) } + ignore <- vapply(df, inherits, what = "AsIs", logical(1)) backtransformed <- unlist(lapply( scales, function(scale) { - aesthetics <- intersect(scale$aesthetics, names(df)) + aesthetics <- intersect(scale$aesthetics, names(df[!ignore])) if (length(aesthetics) == 0) { return() } From 678992a03cf67f0a8e1038235d4ca732397b857c Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 22:25:13 +0200 Subject: [PATCH 3/8] Position scales ignore AsIs --- R/facet-.R | 6 ++++-- R/layout.R | 6 ++++-- R/position-.R | 1 + 3 files changed, 9 insertions(+), 4 deletions(-) diff --git a/R/facet-.R b/R/facet-.R index 2f92697d25..02e5b2d5b9 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -102,16 +102,18 @@ Facet <- ggproto("Facet", NULL, # loop over each layer, training x and y scales in turn for (layer_data in data) { match_id <- match(layer_data$PANEL, layout$PANEL) + names <- names(layer_data) + names <- names[!vapply(layer_data, inherits, what = "AsIs", logical(1))] if (!is.null(x_scales)) { - x_vars <- intersect(x_scales[[1]]$aesthetics, names(layer_data)) + x_vars <- intersect(x_scales[[1]]$aesthetics, names) SCALE_X <- layout$SCALE_X[match_id] scale_apply(layer_data, x_vars, "train", SCALE_X, x_scales) } if (!is.null(y_scales)) { - y_vars <- intersect(y_scales[[1]]$aesthetics, names(layer_data)) + y_vars <- intersect(y_scales[[1]]$aesthetics, names) SCALE_Y <- layout$SCALE_Y[match_id] scale_apply(layer_data, y_vars, "train", SCALE_Y, y_scales) diff --git a/R/layout.R b/R/layout.R index 56841b647b..431ea12489 100644 --- a/R/layout.R +++ b/R/layout.R @@ -152,16 +152,18 @@ Layout <- ggproto("Layout", NULL, lapply(data, function(layer_data) { match_id <- match(layer_data$PANEL, layout$PANEL) + names <- names(layer_data) + names <- names[!vapply(layer_data, inherits, what = "AsIs", logical(1))] # Loop through each variable, mapping across each scale, then joining # back together - x_vars <- intersect(self$panel_scales_x[[1]]$aesthetics, names(layer_data)) + x_vars <- intersect(self$panel_scales_x[[1]]$aesthetics, names) names(x_vars) <- x_vars SCALE_X <- layout$SCALE_X[match_id] new_x <- scale_apply(layer_data, x_vars, "map", SCALE_X, self$panel_scales_x) layer_data[, x_vars] <- new_x - y_vars <- intersect(self$panel_scales_y[[1]]$aesthetics, names(layer_data)) + y_vars <- intersect(self$panel_scales_y[[1]]$aesthetics, names) names(y_vars) <- y_vars SCALE_Y <- layout$SCALE_Y[match_id] new_y <- scale_apply(layer_data, y_vars, "map", SCALE_Y, self$panel_scales_y) diff --git a/R/position-.R b/R/position-.R index e9ea2ddf6f..a08cce633d 100644 --- a/R/position-.R +++ b/R/position-.R @@ -79,6 +79,7 @@ transform_position <- function(df, trans_x = NULL, trans_y = NULL, ...) { oldclass <- class(df) df <- unclass(df) scales <- aes_to_scale(names(df)) + scales[vapply(df, inherits, what = "AsIs", logical(1))] <- "ignored" if (!is.null(trans_x)) { df[scales == "x"] <- lapply(df[scales == "x"], trans_x, ...) From a6b63fea7121f4f584b4d57b7875a578c0ce03e9 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 22:42:40 +0200 Subject: [PATCH 4/8] Add test --- .../_snaps/scales/scales-ignore-i.svg | 74 +++++++++++++++++++ tests/testthat/test-scales.R | 20 +++++ 2 files changed, 94 insertions(+) create mode 100644 tests/testthat/_snaps/scales/scales-ignore-i.svg diff --git a/tests/testthat/_snaps/scales/scales-ignore-i.svg b/tests/testthat/_snaps/scales/scales-ignore-i.svg new file mode 100644 index 0000000000..f00e7eeb80 --- /dev/null +++ b/tests/testthat/_snaps/scales/scales-ignore-i.svg @@ -0,0 +1,74 @@ + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + + +I(x) +I(y) +scales ignore I() + + diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 639f65674b..53bb574d94 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -521,3 +521,23 @@ test_that("numeric scale transforms can produce breaks", { expect_equal(test_breaks("sqrt", limits = c(0, 10)), seq(0, 10, by = 2.5)) }) + +test_that("scales ignore I()/AsIs vectors", { + set.seed(42) + df <- data.frame( + x = runif(20), + y = runif(20), + colour = sample(rainbow(20)), + shape = 1:20 + ) + + p <- ggplot(df, aes(I(x), I(y), colour = I(colour), shape = I(shape))) + + geom_point() + data <- layer_data(p) + expect_identical(df$x, unclass(data$x)) + expect_identical(df$y, unclass(data$y)) + expect_identical(df$colour, unclass(data$colour)) + expect_identical(df$shape, unclass(data$shape)) + + expect_doppelganger("scales ignore I()", p) +}) From e59bf613fa8b31bd3cb9a84d09413d0f70717969 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 23:06:42 +0200 Subject: [PATCH 5/8] Refuse discrete AsIs position aesthetics --- R/facet-.R | 16 +++++++++++++++- tests/testthat/_snaps/scales.md | 4 ++++ tests/testthat/test-scales.R | 8 ++++++++ 3 files changed, 27 insertions(+), 1 deletion(-) diff --git a/R/facet-.R b/R/facet-.R index 02e5b2d5b9..e56bfbc14b 100644 --- a/R/facet-.R +++ b/R/facet-.R @@ -103,7 +103,8 @@ Facet <- ggproto("Facet", NULL, for (layer_data in data) { match_id <- match(layer_data$PANEL, layout$PANEL) names <- names(layer_data) - names <- names[!vapply(layer_data, inherits, what = "AsIs", logical(1))] + ignore <- vapply(layer_data, inherits, what = "AsIs", logical(1)) + names <- names[!ignore] if (!is.null(x_scales)) { x_vars <- intersect(x_scales[[1]]$aesthetics, names) @@ -118,6 +119,19 @@ Facet <- ggproto("Facet", NULL, scale_apply(layer_data, y_vars, "train", SCALE_Y, y_scales) } + + # Check if AsIs variables + if (any(ignore)) { + position_aes <- union(ggplot_global$x_aes, ggplot_global$y_aes) + ignored <- intersect(names(ignore)[ignore], position_aes) + is_discrete <- vapply(layer_data[ignored], is.discrete, logical(1)) + if (any(is_discrete)) { + cli::cli_abort(paste0( + "Position aesthetic{?s} {.field {ignored[is_discrete]}} provided ", + "as {.cls AsIs} object{?s} cannot be discrete." + )) + } + } } }, draw_back = function(data, layout, x_scales, y_scales, theme, params) { diff --git a/tests/testthat/_snaps/scales.md b/tests/testthat/_snaps/scales.md index b9adefae05..50df95093f 100644 --- a/tests/testthat/_snaps/scales.md +++ b/tests/testthat/_snaps/scales.md @@ -49,3 +49,7 @@ Output [1] NA 1.00000 20.08554 403.42879 +# discrete I() objects are rejected as position aesthetics + + Position aesthetics x and y provided as objects cannot be discrete. + diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 53bb574d94..34dca45118 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -541,3 +541,11 @@ test_that("scales ignore I()/AsIs vectors", { expect_doppelganger("scales ignore I()", p) }) + +test_that("discrete I() objects are rejected as position aesthetics", { + + p <- ggplot(mapping = aes(x = I("foo"), y = I("bar"))) + + geom_point() + expect_snapshot_error(ggplotGrob(p)) + +}) From 1beb9347280548f2a232575dc5e1df8f3a93ff11 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 23:10:11 +0200 Subject: [PATCH 6/8] Add news bullet --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index 401083cb6d..a6784dc5b3 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,10 @@ # ggplot2 (development version) +* Plot scales now ignore `AsIs` objects constructed with `I(x)`, instead of + invoking the identity scale. This allows these columns to co-exist with other + layers that need a non-identity scale for the same aesthetic. Also, it makes + it easy to specify relative positions (@teunbrand, #5142). + * `geom_text()` and `geom_label()` gained a `size.unit` parameter that set the text size to millimetres, points, centimetres, inches or picas (@teunbrand, #3799). From a14609ea54e98a71572aca8e021804fa38e629db Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 23:38:25 +0200 Subject: [PATCH 7/8] complete.cases -> vec_detect_complete (better for list-columns) --- R/geom-path.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/R/geom-path.R b/R/geom-path.R index 6194d647e1..fd473b0b43 100644 --- a/R/geom-path.R +++ b/R/geom-path.R @@ -135,7 +135,7 @@ GeomPath <- ggproto("GeomPath", Geom, handle_na = function(self, data, params) { # Drop missing values at the start or end of a line - can't drop in the # middle since you expect those to be shown by a break in the line - complete <- stats::complete.cases(data[names(data) %in% c("x", "y", "linewidth", "colour", "linetype")]) + complete <- vec_detect_complete(data[names(data) %in% c("x", "y", "linewidth", "colour", "linetype")]) kept <- stats::ave(complete, data$group, FUN = keep_mid_true) data <- data[kept, ] From 6fd251a5a01ee305bebe72de8aeace74b0d73de4 Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 26 Apr 2023 23:38:57 +0200 Subject: [PATCH 8/8] Forgot old R has stringsAsFactors --- tests/testthat/test-scales.R | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/tests/testthat/test-scales.R b/tests/testthat/test-scales.R index 34dca45118..c36e38509c 100644 --- a/tests/testthat/test-scales.R +++ b/tests/testthat/test-scales.R @@ -524,7 +524,7 @@ test_that("numeric scale transforms can produce breaks", { test_that("scales ignore I()/AsIs vectors", { set.seed(42) - df <- data.frame( + df <- data_frame0( x = runif(20), y = runif(20), colour = sample(rainbow(20)),