diff --git a/NAMESPACE b/NAMESPACE index b15bde6e2f..6a9893e917 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -152,6 +152,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 7f984112bc..a529b46d31 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). + * The `fill` aesthetic in many geoms now accepts grid's patterns and gradients. For developers of layer extensions, this feature can be enabled by switching from `fill = alpha(fill, alpha)` to `fill = fill_alpha(fill, alpha)` when diff --git a/R/plot-build.R b/R/plot-build.R index 51208d20dd..cf3ff3fdcd 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() @@ -97,6 +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) # 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 83ee801273..5888423cea 100644 --- a/R/utilities.R +++ b/R/utilities.R @@ -598,6 +598,69 @@ is_bang <- function(x) { is_call(x, "!", n = 1) } +# Puts all columns with 'AsIs' type in a '.ignore' column. + + + +#' 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) + } + 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. +#' @rdname ignoring_data +#' @export +.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]]])) + }) +} + 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} diff --git a/tests/testthat/test-utilities.R b/tests/testthat/test-utilities.R index 2a695d0117..9604303df9 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")]) + +})