From 905c38b7b8a5bfd61b1239f60e54c1dbdccb1439 Mon Sep 17 00:00:00 2001 From: Elio Campitelli Date: Tue, 12 Jan 2021 18:42:43 -0300 Subject: [PATCH 1/2] facets now don't fail if faceting vars are COL, ROW, etc. Closes #4138 --- R/facet-grid-.r | 43 +++++++++++++++++++++++++----------- R/facet-wrap.r | 26 +++++++++++++++++----- tests/testthat/test-facet-.r | 26 ++++++++++++++++++++++ 3 files changed, 76 insertions(+), 19 deletions(-) diff --git a/R/facet-grid-.r b/R/facet-grid-.r index 4bdb4e137a..aae5f0bad2 100644 --- a/R/facet-grid-.r +++ b/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 { diff --git a/R/facet-wrap.r b/R/facet-wrap.r index 05fbdd29a0..f432731fc3 100644 --- a/R/facet-wrap.r +++ b/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( diff --git a/tests/testthat/test-facet-.r b/tests/testthat/test-facet-.r index a010256953..8cefd2f49e 100644 --- a/tests/testthat/test-facet-.r +++ b/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", { From e29a6644a55451786ffc45a24d360a10c36facd7 Mon Sep 17 00:00:00 2001 From: Elio Campitelli Date: Tue, 12 Jan 2021 18:50:34 -0300 Subject: [PATCH 2/2] Updates news. --- NEWS.md | 3 +++ 1 file changed, 3 insertions(+) diff --git a/NEWS.md b/NEWS.md index 95fdb0541d..c55916c672 100644 --- a/NEWS.md +++ b/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)