geom_rect() can derive corners from x/width or y/height

NEWS.md

@@ -1,5 +1,7 @@
 # ggplot2 (development version)
 
+* `geom_rect()` can now derive the required corners positions from `x`/`width`
+ or `y`/`height` parameterisation (@teunbrand, #5861).
 * Fixed bug where binned guides would keep out-of-bounds breaks 
  (@teunbrand, #5870).
 * The size of the `draw_key_polygon()` glyph now reflects the `linewidth` 

R/geom-rect.R

@@ -31,7 +31,39 @@ GeomRect <- ggproto("GeomRect", Geom,
  default_aes = aes(colour = NA, fill = "grey35", linewidth = 0.5, linetype = 1,
  alpha = NA),
 
- required_aes = c("xmin", "xmax", "ymin", "ymax"),
+ required_aes = c("x|width|xmin|xmax", "y|height|ymin|ymax"),
+
+ setup_data = function(self, data, params) {
+ if (all(c("xmin", "xmax", "ymin", "ymax") %in% names(data))) {
+ return(data)
+ }
+
+ # Fill in missing aesthetics from parameters
+ required <- strsplit(self$required_aes, "|", fixed = TRUE)
+ missing <- setdiff(unlist(required), names(data))
+ default <- params[intersect(missing, names(params))]
+ data[names(default)] <- default
+
+ if (is.null(data$xmin) || is.null(data$xmax)) {
+ x <- resolve_rect(
+ data[["xmin"]], data[["xmax"]],
+ data[["x"]], data[["width"]],
+ fun = snake_class(self), type = "x"
+ )
+ i <- lengths(x) > 1
+ data[c("xmin", "xmax")[i]] <- x[i]
+ }
+ if (is.null(data$ymin) || is.null(data$ymax)) {
+ y <- resolve_rect(
+ data[["ymin"]], data[["ymax"]],
+ data[["y"]], data[["height"]],
+ fun = snake_class(self), type = "y"
+ )
+ i <- lengths(y) > 1
+ data[c("ymin", "ymax")[i]] <- y[i]
+ }
+ data
+ },
 
  draw_panel = function(self, data, panel_params, coord, lineend = "butt", linejoin = "mitre") {
  data <- check_linewidth(data, snake_class(self))
@@ -73,3 +105,41 @@ GeomRect <- ggproto("GeomRect", Geom,
 
  rename_size = TRUE
 )
+
+resolve_rect <- function(min = NULL, max = NULL, center = NULL, length = NULL,
+ fun, type) {
+ absent <- c(is.null(min), is.null(max), is.null(center), is.null(length))
+ if (sum(absent) > 2) {
+ missing <- switch(
+ type,
+ x = c("xmin", "xmax", "x", "width"),
+ y = c("ymin", "ymax", "y", "height")
+ )
+ cli::cli_abort(c(
+ "{.fn {fun}} requires two of the following aesthetics: \\
+ {.or {.field {missing}}}.",
+ i = "Currently, {.field {missing[!absent]}} is present."
+ ))
+ }
+
+ if (absent[1] && absent[2]) {
+ min <- center - 0.5 * length
+ max <- center + 0.5 * length
+ return(list(min = min, max = max))
+ }
+ if (absent[1]) {
+ if (is.null(center)) {
+ min <- max - length
+ } else {
+ min <- max - 2 * (max - center)
+ }
+ }
+ if (absent[2]) {
+ if (is.null(center)) {
+ max <- min + length
+ } else {
+ max <- min + 2 * (center - min)
+ }
+ }
+ list(min = min, max = max)
+}

R/geom-tile.R

@@ -1,25 +1,26 @@
 #' Rectangles
 #'
 #' `geom_rect()` and `geom_tile()` do the same thing, but are
-#' parameterised differently: `geom_rect()` uses the locations of the four
-#' corners (`xmin`, `xmax`, `ymin` and `ymax`), while
-#' `geom_tile()` uses the center of the tile and its size (`x`,
-#' `y`, `width`, `height`). `geom_raster()` is a high
-#' performance special case for when all the tiles are the same size, and no
-#' pattern fills are applied.
+#' parameterised differently: `geom_tile()` uses the center of the tile and its
+#' size (`x`, `y`, `width`, `height`), while `geom_rect()` can use those or the
+#' locations of the corners (`xmin`, `xmax`, `ymin` and `ymax`).
+#' `geom_raster()` is a high performance special case for when all the tiles
+#' are the same size, and no pattern fills are applied.
 #'
-#' @eval rd_aesthetics("geom", "tile", "Note that `geom_raster()` ignores `colour`.")
+#' @eval rd_aesthetics(
+#' "geom", "rect",
+#' "`geom_tile()` understands only the `x`/`width` and `y`/`height` combinations.
+#' Note that `geom_raster()` ignores `colour`."
+#' )
 #' @inheritParams layer
 #' @inheritParams geom_point
 #' @inheritParams geom_segment
 #' @export
 #'
 #' @details
-#' `geom_rect()` and `geom_tile()`'s respond differently to scale
-#' transformations due to their parameterisation. In `geom_rect()`, the scale
-#' transformation is applied to the corners of the rectangles. In `geom_tile()`,
-#' the transformation is applied only to the centres and its size is determined
-#' after transformation.
+#' Please note that the `width` and `height` aesthetics are not true position
+#' aesthetics and therefore are not subject to scale transformation. It is
+#' only after transformation that these aesthetics are applied.
 #'
 #' @examples
 #' # The most common use for rectangles is to draw a surface. You always want

R/utilities-help.R

@@ -23,7 +23,7 @@ rd_aesthetics <- function(type, name, extra_note = NULL) {
 
 rd_aesthetics_item <- function(x) {
  req <- x$required_aes
- req <- sub("|", "} \\emph{or} \\code{", req, fixed = TRUE)
+ req <- gsub("|", "} \\emph{or} \\code{", req, fixed = TRUE)
  req_aes <- unlist(strsplit(x$required_aes, "|", fixed = TRUE))
  optional_aes <- setdiff(x$aesthetics(), req_aes)
  all <- union(req, sort(optional_aes))

R/utilities.R

@@ -24,25 +24,53 @@ scales::alpha
 # @param name of object for error message
 # @keyword internal
 check_required_aesthetics <- function(required, present, name, call = caller_env()) {
- if (is.null(required)) return()
+ if (is.null(required)) {
+ return()
+ }
 
  required <- strsplit(required, "|", fixed = TRUE)
- if (any(lengths(required) > 1)) {
- required <- lapply(required, rep_len, 2)
- required <- list(
- vapply(required, `[`, character(1), 1),
- vapply(required, `[`, character(1), 2)
+ n <- lengths(required)
+
+ is_present <- vapply(
+ required,
+ function(req) any(req %in% present),
+ logical(1)
+ )
+ if (all(is_present)) {
+ return()
+ }
+
+ # Deal with paired (bidirectional) aesthetics
+ pairs <- character()
+ missing_pairs <- n == 2
+ if (any(missing_pairs)) {
+ pairs <- lapply(required[missing_pairs], rep_len, 2)
+ pairs <- list(
+ vapply(pairs, `[`, character(1), 1),
+ vapply(pairs, `[`, character(1), 2)
  )
- } else {
- required <- list(unlist(required))
+ pairs <- lapply(pairs, setdiff, present)
+ pairs <- vapply(pairs, function(x) {
+ as_cli("{.and {.field {x}}}")
+ }, character(1))
+ pairs <- as_cli("{.or {pairs}}")
  }
- missing_aes <- lapply(required, setdiff, present)
- if (any(lengths(missing_aes) == 0)) return()
- message <- "{.fn {name}} requires the following missing aesthetics: {.field {missing_aes[[1]]}}"
- if (length(missing_aes) > 1) {
- message <- paste0(message, " {.strong or} {.field {missing_aes[[2]]}}")
+
+ other <- character()
+ missing_other <- !is_present & n != 2
+ if (any(missing_other)) {
+ other <- lapply(required[missing_other], setdiff, present)
+ other <- vapply(other, function(x) {
+ as_cli("{.or {.field {x}}}")
+ }, character(1))
  }
- cli::cli_abort(paste0(message, "."), call = call)
+
+ missing <- c(other, pairs)
+
+ cli::cli_abort(
+ "{.fn {name}} requires the following missing aesthetics: {.and {missing}}.",
+ call = call
+ )
 }
 
 # Concatenate a named list for output

tests/testthat/_snaps/utilities.md

@@ -12,7 +12,7 @@
 
 ---
 
- `test()` requires the following missing aesthetics: x and fill or y and fill.
+ `test()` requires the following missing aesthetics: fill and x or y.
 
 # remove_missing checks input
 

tests/testthat/test-geom-rect.R

@@ -0,0 +1,36 @@
+test_that("geom_rect can derive corners", {
+
+ corners <- c("xmin", "xmax", "ymin", "ymax")
+ full <- data.frame(
+ xmin = c(1, 2), xmax = c(3, 6),
+ ymin = c(1, 2), ymax = c(3, 6),
+ width = c(2, 4), height = c(2, 4),
+ x = c(2, 4), y = c(2, 4)
+ )
+
+ test <- full[, c("xmin", "ymin", "width", "height")]
+ test <- GeomRect$setup_data(test, NULL)
+ expect_equal(full[, corners], test[, corners])
+
+ test <- full[, c("xmin", "ymin", "x", "y")]
+ test <- GeomRect$setup_data(test, NULL)
+ expect_equal(full[, corners], test[, corners])
+
+ test <- full[, c("x", "y", "width", "height")]
+ test <- GeomRect$setup_data(test, NULL)
+ expect_equal(full[, corners], test[, corners])
+
+ test <- full[, c("xmax", "ymax", "width", "height")]
+ test <- GeomRect$setup_data(test, NULL)
+ expect_equal(full[, corners], test[, corners])
+
+ test <- full[, c("xmax", "ymax", "x", "y")]
+ test <- GeomRect$setup_data(test, NULL)
+ expect_equal(full[, corners], test[, corners])
+
+ test <- full[, c("x", "y")]
+ expect_error(
+ GeomRect$setup_data(test, NULL),
+ "requires two of the following aesthetics"
+ )
+})