Facets now don't fail if faceting vars are COL, ROW, etc.

NEWS.md

@@ -1,5 +1,8 @@
 # ggplot2 (development version)
 
+* `facet_grid()` and `facet_wrap()` now don't fail when faceting variables are named
+"COL", "ROW", "PANEL", "SCALE_X" or "SCALE_Y". (@eliocamp, #4138)
+
 * `ggsave()` now sets the default background to match the fill value of the
   `plot.background` theme element (@karawoo, #4057)
 

R/facet-grid-.r

@@ -224,13 +224,21 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     rows <- if (!length(names(rows))) rep(1L, length(panel)) else id(base[names(rows)], drop = TRUE)
     cols <- if (!length(names(cols))) rep(1L, length(panel)) else id(base[names(cols)], drop = TRUE)
 
-    panels <- new_data_frame(c(list(PANEL = panel, ROW = rows, COL = cols), base))
+    SCALE_X <- if (params$free$x) cols else 1L
+    SCALE_Y <- if (params$free$y) rows else 1L
+
+    panels <- new_data_frame(list(PANEL = panel, ROW = rows, COL = cols,
+                                  SCALE_X = SCALE_X, SCALE_Y = SCALE_Y))
+
+    # Append data columns at the end. This helps to divide columns
+    # that refer to the data and those that refer to layout, which is
+    # important if there's duplicated column names (columns in data called
+    # COL, PANEL, usw.) and ensures that, for example layout$SCALE_X will catch
+    # the correct column.
+    panels <- cbind(panels, unrowname(base))
     panels <- panels[order(panels$PANEL), , drop = FALSE]
     rownames(panels) <- NULL
 
-    panels$SCALE_X <- if (params$free$x) panels$COL else 1L
-    panels$SCALE_Y <- if (params$free$y) panels$ROW else 1L
-
     panels
   },
   map_data = function(data, layout, params) {
@@ -277,7 +285,10 @@ FacetGrid <- ggproto("FacetGrid", Facet,
       facet_vals[] <- lapply(facet_vals[], as.factor)
       facet_vals[] <- lapply(facet_vals[], addNA, ifany = TRUE)
 
-      keys <- join_keys(facet_vals, layout, by = vars)
+      # the first five columns ("PANEL", "ROW", "COLUMN", "SCALE_X" and "SCALE_Y")
+      # columns are not data columns. Don't use it for join.
+      layout_columns <- 1:5
+      keys <- join_keys(facet_vals, layout[, -layout_columns, drop = FALSE], by = vars)
 
       data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
     }
@@ -288,12 +299,18 @@ FacetGrid <- ggproto("FacetGrid", Facet,
       abort(glue("{snake_class(coord)} doesn't support free scales"))
     }
 
-    cols <- which(layout$ROW == 1)
-    rows <- which(layout$COL == 1)
+    # Split layout into the columns that refer to data and those that
+    # refer to layout
+    layout_columns <- 1:5
+    layout_data <- layout[, -layout_columns, drop = FALSE]
+    layout_no_data <- layout[, layout_columns, drop = FALSE]
+
+    cols <- which(layout_no_data$ROW == 1)
+    rows <- which(layout_no_data$COL == 1)
     axes <- render_axes(ranges[cols], ranges[rows], coord, theme, transpose = TRUE)
 
-    col_vars <- unique(layout[names(params$cols)])
-    row_vars <- unique(layout[names(params$rows)])
+    col_vars <- unique(layout_data[names(params$cols)])
+    row_vars <- unique(layout_data[names(params$rows)])
     # Adding labels metadata, useful for labellers
     attr(col_vars, "type") <- "cols"
     attr(col_vars, "facet") <- "grid"
@@ -311,8 +328,8 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     } else {
       respect <- TRUE
     }
-    ncol <- max(layout$COL)
-    nrow <- max(layout$ROW)
+    ncol <- max(layout_no_data$COL)
+    nrow <- max(layout_no_data$ROW)
     panel_table <- matrix(panels, nrow = nrow, ncol = ncol, byrow = TRUE)
 
     # @kohske
@@ -322,14 +339,14 @@ FacetGrid <- ggproto("FacetGrid", Facet,
     #
     # In general, panel has all information for building facet.
     if (params$space_free$x) {
-      ps <- layout$PANEL[layout$ROW == 1]
+      ps <- layout_no_data$PANEL[layout_no_data$ROW == 1]
       widths <- vapply(ps, function(i) diff(ranges[[i]]$x.range), numeric(1))
       panel_widths <- unit(widths, "null")
     } else {
       panel_widths <- rep(unit(1, "null"), ncol)
     }
     if (params$space_free$y) {
-      ps <- layout$PANEL[layout$COL == 1]
+      ps <- layout_no_data$PANEL[layout_no_data$COL == 1]
       heights <- vapply(ps, function(i) diff(ranges[[i]]$y.range), numeric(1))
       panel_heights <- unit(heights, "null")
     } else {

R/facet-wrap.r

@@ -165,14 +165,19 @@ FacetWrap <- ggproto("FacetWrap", Facet,
       layout[c("ROW", "COL")] <- layout[c("COL", "ROW")]
     }
 
+    # Add scale identification
+    layout$SCALE_X <- if (params$free$x) seq_len(n) else 1L
+    layout$SCALE_Y <- if (params$free$y) seq_len(n) else 1L
+
+    # Append data columns at the end. This helps to divide columns
+    # that refer to the data and those that refer to layout, which is
+    # important if there's duplicated column names (columns in data called
+    # COL, PANEL, usw.) and ensures that, for example layout$SCALE_X will catch
+    # the correct column.
     panels <- cbind(layout, unrowname(base))
     panels <- panels[order(panels$PANEL), , drop = FALSE]
     rownames(panels) <- NULL
 
-    # Add scale identification
-    panels$SCALE_X <- if (params$free$x) seq_len(n) else 1L
-    panels$SCALE_Y <- if (params$free$y) seq_len(n) else 1L
-
     panels
   },
   map_data = function(data, layout, params) {
@@ -204,7 +209,10 @@ FacetWrap <- ggproto("FacetWrap", Facet,
         to_add[facet_rep, , drop = FALSE]))
     }
 
-    keys <- join_keys(facet_vals, layout, by = names(vars))
+    # the first five columns ("PANEL", "ROW", "COLUMN", "SCALE_X" and "SCALE_Y")
+    # columns are not data columns. Don't use it for join.
+    layout_columns <- 1:5
+    keys <- join_keys(facet_vals, layout[, -layout_columns, drop = FALSE], by = names(vars))
 
     data$PANEL <- layout$PANEL[match(keys$x, keys$y)]
     data
@@ -227,6 +235,7 @@ FacetWrap <- ggproto("FacetWrap", Facet,
       }
     }
 
+
     ncol <- max(layout$COL)
     nrow <- max(layout$ROW)
     n <- nrow(layout)
@@ -235,13 +244,18 @@ FacetWrap <- ggproto("FacetWrap", Facet,
     panels <- panels[panel_order]
     panel_pos <- convertInd(layout$ROW, layout$COL, nrow)
 
+    # Split layout into the columns that refer to data and those that
+    # refer to layout
+    layout_columns <- 1:5
+    layout_data <- layout[, -layout_columns, drop = FALSE]
+
     axes <- render_axes(ranges, ranges, coord, theme, transpose = TRUE)
 
     if (length(params$facets) == 0) {
       # Add a dummy label
       labels_df <- new_data_frame(list("(all)" = "(all)"), n = 1)
     } else {
-      labels_df <- layout[names(params$facets)]
+      labels_df <- layout_data[names(params$facets)]
     }
     attr(labels_df, "facet") <- "wrap"
     strips <- render_strips(

tests/testthat/test-facet-.r

@@ -344,6 +344,32 @@ test_that("eval_facet() is tolerant for missing columns (#2963)", {
   )
 })
 
+
+test_that("facets work with columns named ROW, COL, PANEL, usw...", {
+  data(mtcars)
+
+  mtcars$ROW <- mtcars$cyl
+  mtcars$COL <- mtcars$cyl
+  mtcars$PANEL <- mtcars$cyl
+  mtcars$SCALE_X <- mtcars$cyl
+  mtcars$SCALE_Y <- mtcars$cyl
+
+
+  base <- ggplot(mtcars, aes(hp, mpg)) +
+    geom_point()
+
+  cols <- c("COL", "ROW", "PANEL", "SCALE_X", "SCALE_Y")
+
+  sink <- lapply(cols, function(col) {
+    expect_error(print(base + facet_wrap(as.formula(paste0(col, " ~  am")))), NA)
+  })
+
+  sink <- lapply(cols, function(col) {
+    expect_error(print(base + facet_grid(as.formula(paste0(col, " ~  am")))), NA)
+  })
+
+})
+
 # Visual tests ------------------------------------------------------------
 
 test_that("facet labels respect both justification and margin arguments", {