Ignoring AsIs objects (again) (#5477)

* Write some utility functions

* ignore data around scale operations

* Simple test for expose/ignore

* Add news bullet

* use '.'-prefix

* export ignore/expose functions

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)

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 

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")

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 `<AsIs>` columns during
+#' scale interactions in `ggplot_build()`. The `.expose_data()` function is
+#' used to restore hidden columns.
+#'
+#' @param data A list of `<data.frame>`s.
+#'
+#' @return A modified list of `<data.frame>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)

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")])
+
+})