Ignoring AsIs objects (again)

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)

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).
+
 * New `guide_axis_stack()` to combine other axis guides on top of one another.
 
 * New `guide_custom()` function for drawing custom graphical objects (grobs)

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