From 9521343e3ddfaa1c56a3e757e544b42fe2b4afef Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 11 Oct 2023 15:52:18 +0200 Subject: [PATCH 1/6] Write some utility functions --- R/utilities.R | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) diff --git a/R/utilities.R b/R/utilities.R index 1efbc121ff..422e5244a6 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -598,6 +598,47 @@ is_bang <- function(x) { is_call(x, "!", n = 1) } +# Puts all columns with 'AsIs' type in a '.ignore' column. +ignore_data <- function(data) { + if (!is_bare_list(data)) { + data <- list(data) + } + lapply(data, function(df) { + is_asis <- vapply(df, inherits, logical(1), what = "AsIs") + if (!any(is_asis)) { + return(df) + } + df <- unclass(df) + # We trust that 'df' is a valid data.frame with equal length columns etc, + # so we can use the more performant `new_data_frame()` + new_data_frame(c( + df[!is_asis], + list(.ignored = new_data_frame(df[is_asis])) + )) + }) +} + +# Restores all columns packed into the '.ignored' column. +expose_data <- function(data) { + if (!is_bare_list(data)) { + data <- list(data) + } + lapply(data, function(df) { + is_ignored <- which(names(df) == ".ignored") + if (length(is_ignored) == 0) { + return(df) + } + df <- unclass(df) + new_data_frame(c(df[-is_ignored], df[[is_ignored[1]]])) + }) +} + +#' @export +#' @method rescale AsIs +rescale.AsIs <- function(x, to, from, ...) { + x +} + is_triple_bang <- function(x) { if (!is_bang(x)) { return(FALSE) From 5b7ae398ad4f0157cfc2ba80e53a5ff1d7b4151e Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 11 Oct 2023 15:52:39 +0200 Subject: [PATCH 2/6] ignore data around scale operations --- R/plot-build.R | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/R/plot-build.R b/R/plot-build.R index 2c1695e350..1d8513e63d 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -51,6 +51,7 @@ ggplot_build.ggplot <- function(plot) { # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot), layers, data, "computing aesthetics") + data <- ignore_data(data) # Transform all scales data <- lapply(data, scales$transform_df) @@ -62,6 +63,7 @@ ggplot_build.ggplot <- function(plot) { layout$train_position(data, scale_x(), scale_y()) data <- layout$map_position(data) + data <- expose_data(data) # Apply and map statistics data <- by_layer(function(l, d) l$compute_statistic(d, layout), layers, data, "computing stat") @@ -79,6 +81,7 @@ ggplot_build.ggplot <- function(plot) { # Reset position scales, then re-train and map. This ensures that facets # have control over the range of a plot: is it generated from what is # displayed, or does it include the range of underlying data + data <- ignore_data(data) layout$reset_scales() layout$train_position(data, scale_x(), scale_y()) layout$setup_panel_params() @@ -90,6 +93,7 @@ ggplot_build.ggplot <- function(plot) { lapply(data, npscales$train_df) data <- lapply(data, npscales$map_df) } + data <- expose_data(data) # Fill in defaults etc. data <- by_layer(function(l, d) l$compute_geom_2(d), layers, data, "setting up geom aesthetics") From 507b41d427e9b532719dc1ca56241994eda8882a Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Wed, 11 Oct 2023 15:55:10 +0200 Subject: [PATCH 3/6] Simple test for expose/ignore --- tests/testthat/test-utilities.R | 18 ++++++++++++++++++ 1 file changed, 18 insertions(+) diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 2a695d0117..6d29a052a6 100644 --- a/tests/testthat/test-utilities.R +++ b/tests/testthat/test-utilities.R @@ -177,3 +177,21 @@ test_that("resolution() gives correct answers", { # resolution has a tolerance expect_equal(resolution(c(1, 1 + 1000 * .Machine$double.eps, 2)), 1) }) + +test_that("expose/ignore_data() can round-trip a data.frame", { + + # Plain data.frame + df <- data_frame0(a = 1:3, b = 4:6, c = LETTERS[1:3], d = LETTERS[4:6]) + expect_equal(list(df), ignore_data(df)) + expect_equal(list(df), expose_data(df)) + + # data.frame with ignored columns + df <- data_frame0(a = 1:3, b = I(4:6), c = LETTERS[1:3], d = I(LETTERS[4:6])) + test <- ignore_data(df)[[1]] + expect_equal(names(test), c("a", "c", ".ignored")) + expect_equal(names(test$.ignored), c("b", "d")) + + test <- expose_data(test)[[1]] + expect_equal(test, df[, c("a", "c", "b", "d")]) + +}) From cf337e36ceb1561101bcfe1215ce8c7eddfa7b1f Mon Sep 17 00:00:00 2001 From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com> Date: Thu, 12 Oct 2023 10:44:00 +0200 Subject: [PATCH 4/6] Add news bullet --- NEWS.md | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/NEWS.md b/NEWS.md index bc1f4059e8..3bcd5b3805 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). + * Legend titles no longer take up space if they've been removed by setting `legend.title = element_blank()` (@teunbrand, #3587). From 2ba6bb745b26010ddcdae66d8573b81e5c1d17cc Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 6 Dec 2023 10:12:11 +0100 Subject: [PATCH 5/6] use '.'-prefix --- R/plot-build.R | 8 ++++---- R/utilities.R | 2 ++ tests/testthat/test-utilities.R | 8 ++++---- 3 files changed, 10 insertions(+), 8 deletions(-) diff --git a/R/plot-build.R b/R/plot-build.R index f6c307312c..ca3e6714b8 100644 --- a/R/plot-build.R +++ b/R/plot-build.R @@ -51,7 +51,7 @@ ggplot_build.ggplot <- function(plot) { # Compute aesthetics to produce data with generalised variable names data <- by_layer(function(l, d) l$compute_aesthetics(d, plot), layers, data, "computing aesthetics") - data <- ignore_data(data) + data <- .ignore_data(data) # Transform all scales data <- lapply(data, scales$transform_df) @@ -63,7 +63,7 @@ ggplot_build.ggplot <- function(plot) { layout$train_position(data, scale_x(), scale_y()) data <- layout$map_position(data) - data <- expose_data(data) + data <- .expose_data(data) # Apply and map statistics data <- by_layer(function(l, d) l$compute_statistic(d, layout), layers, data, "computing stat") @@ -81,7 +81,7 @@ ggplot_build.ggplot <- function(plot) { # Reset position scales, then re-train and map. This ensures that facets # have control over the range of a plot: is it generated from what is # displayed, or does it include the range of underlying data - data <- ignore_data(data) + data <- .ignore_data(data) layout$reset_scales() layout$train_position(data, scale_x(), scale_y()) layout$setup_panel_params() @@ -100,7 +100,7 @@ ggplot_build.ggplot <- function(plot) { # Only keep custom guides if there are no non-position scales plot$guides <- plot$guides$get_custom() } - data <- expose_data(data) + data <- .expose_data(data) # Fill in defaults etc. data <- by_layer(function(l, d) l$compute_geom_2(d), layers, data, "setting up geom aesthetics") diff --git a/R/utilities.R b/R/utilities.R index df065d8c9f..b6f87d4d60 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -600,6 +600,7 @@ is_bang <- function(x) { # Puts all columns with 'AsIs' type in a '.ignore' column. ignore_data <- function(data) { +.ignore_data <- function(data) { if (!is_bare_list(data)) { data <- list(data) } @@ -620,6 +621,7 @@ ignore_data <- function(data) { # Restores all columns packed into the '.ignored' column. expose_data <- function(data) { +.expose_data <- function(data) { if (!is_bare_list(data)) { data <- list(data) } diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 6d29a052a6..9604303df9 100644 --- a/tests/testthat/test-utilities.R +++ b/tests/testthat/test-utilities.R @@ -182,16 +182,16 @@ test_that("expose/ignore_data() can round-trip a data.frame", { # Plain data.frame df <- data_frame0(a = 1:3, b = 4:6, c = LETTERS[1:3], d = LETTERS[4:6]) - expect_equal(list(df), ignore_data(df)) - expect_equal(list(df), expose_data(df)) + expect_equal(list(df), .ignore_data(df)) + expect_equal(list(df), .expose_data(df)) # data.frame with ignored columns df <- data_frame0(a = 1:3, b = I(4:6), c = LETTERS[1:3], d = I(LETTERS[4:6])) - test <- ignore_data(df)[[1]] + test <- .ignore_data(df)[[1]] expect_equal(names(test), c("a", "c", ".ignored")) expect_equal(names(test$.ignored), c("b", "d")) - test <- expose_data(test)[[1]] + test <- .expose_data(test)[[1]] expect_equal(test, df[, c("a", "c", "b", "d")]) }) From b98de7022647ede9d2f61b1bd6541066bc8ecd8e Mon Sep 17 00:00:00 2001 From: Teun van den Brand Date: Wed, 6 Dec 2023 10:13:28 +0100 Subject: [PATCH 6/6] export ignore/expose functions --- NAMESPACE | 2 ++ NEWS.md | 1 + R/utilities.R | 36 ++++++++++++++++++++++++++++-------- man/ignoring_data.Rd | 35 +++++++++++++++++++++++++++++++++++ 4 files changed, 66 insertions(+), 8 deletions(-) create mode 100644 man/ignoring_data.Rd diff --git a/NAMESPACE b/NAMESPACE index b423ca0bbc..61aa7d854e 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -148,6 +148,8 @@ S3method(widthDetails,zeroGrob) export("%+%") export("%+replace%") export(.data) +export(.expose_data) +export(.ignore_data) export(.pt) export(.stroke) export(AxisSecondary) diff --git a/NEWS.md b/NEWS.md index ccf10fa4fc..55d7612934 100644 --- a/NEWS.md +++ b/NEWS.md @@ -4,6 +4,7 @@ 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). + * New `guide_custom()` function for drawing custom graphical objects (grobs) unrelated to scales in legend positions (#5416). diff --git a/R/utilities.R b/R/utilities.R index b6f87d4d60..5888423cea 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -599,7 +599,32 @@ is_bang <- function(x) { } # Puts all columns with 'AsIs' type in a '.ignore' column. -ignore_data <- function(data) { + + + +#' Ignoring and exposing data +#' +#' The `.ignore_data()` function is used to hide `` columns during +#' scale interactions in `ggplot_build()`. The `.expose_data()` function is +#' used to restore hidden columns. +#' +#' @param data A list of ``s. +#' +#' @return A modified list of `s` +#' @export +#' @keywords internal +#' @name ignoring_data +#' +#' @examples +#' data <- list( +#' data.frame(x = 1:3, y = I(1:3)), +#' data.frame(w = I(1:3), z = 1:3) +#' ) +#' +#' ignored <- .ignore_data(data) +#' str(ignored) +#' +#' .expose_data(ignored) .ignore_data <- function(data) { if (!is_bare_list(data)) { data <- list(data) @@ -620,7 +645,8 @@ ignore_data <- function(data) { } # Restores all columns packed into the '.ignored' column. -expose_data <- function(data) { +#' @rdname ignoring_data +#' @export .expose_data <- function(data) { if (!is_bare_list(data)) { data <- list(data) @@ -635,12 +661,6 @@ expose_data <- function(data) { }) } -#' @export -#' @method rescale AsIs -rescale.AsIs <- function(x, to, from, ...) { - x -} - is_triple_bang <- function(x) { if (!is_bang(x)) { return(FALSE) diff --git a/man/ignoring_data.Rd b/man/ignoring_data.Rd new file mode 100644 index 0000000000..4f1e0817d8 --- /dev/null +++ b/man/ignoring_data.Rd @@ -0,0 +1,35 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/utilities.R +\name{ignoring_data} +\alias{ignoring_data} +\alias{.ignore_data} +\alias{.expose_data} +\title{Ignoring and exposing data} +\usage{ +.ignore_data(data) + +.expose_data(data) +} +\arguments{ +\item{data}{A list of \verb{}s.} +} +\value{ +A modified list of \verb{s} +} +\description{ +The \code{.ignore_data()} function is used to hide \verb{} columns during +scale interactions in \code{ggplot_build()}. The \code{.expose_data()} function is +used to restore hidden columns. +} +\examples{ +data <- list( + data.frame(x = 1:3, y = I(1:3)), + data.frame(w = I(1:3), z = 1:3) +) + +ignored <- .ignore_data(data) +str(ignored) + +.expose_data(ignored) +} +\keyword{internal}