Ignoring AsIs objects (again)

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

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

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)

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