Merge branch 'main' into mgcv_suggests

Author: teunbrand

DESCRIPTION

@@ -33,7 +33,6 @@ Depends:
     R (>= 3.5)
 Imports: 
     cli,
-    glue,
     grDevices,
     grid,
     gtable (>= 0.1.1),

NAMESPACE

@@ -727,8 +727,6 @@ import(gtable)
 import(rlang)
 import(scales)
 import(vctrs)
-importFrom(glue,glue)
-importFrom(glue,glue_collapse)
 importFrom(grid,arrow)
 importFrom(grid,unit)
 importFrom(lifecycle,deprecated)

NEWS.md

@@ -1,6 +1,9 @@
 # ggplot2 (development version)
 
 * Moved {mgcv} from Imports to Suggests (@teunbrand, #5986)
+* ggplot2 no longer imports {glue} (@teunbrand, #5986).
+* `geom_rect()` can now derive the required corners positions from `x`/`width`
+  or `y`/`height` parameterisation (@teunbrand, #5861).
 * All position scales now use the same definition of `x` and `y` aesthetics.
   This lets uncommon aesthetics like `xintercept` expand scales as usual.
   (#3342, #4966, @teunbrand)

R/aes-evaluation.R

@@ -231,9 +231,9 @@ is_calculated <- function(x, warn = FALSE) {
   } else if (is.symbol(x)) {
     res <- is_dotted_var(as.character(x))
     if (res && warn) {
-      what <- I(glue("The dot-dot notation (`{x}`)"))
+      what <- I(paste0("The dot-dot notation (`", x, "`)"))
       var <- gsub(match_calculated_aes, "\\1", as.character(x))
-      with <- I(glue("`after_stat({var})`"))
+      with <- I(paste0("`after_stat(", var, ")`"))
       deprecate_warn0("3.4.0", what, with, id = "ggplot-warn-aes-dot-dot")
     }
     res
@@ -242,9 +242,9 @@ is_calculated <- function(x, warn = FALSE) {
   } else if (is.call(x)) {
     if (identical(x[[1]], quote(stat))) {
       if (warn) {
-        what <- I(glue("`{expr_deparse(x)}`"))
+        what <- I(paste0("`", expr_deparse(x), "`"))
         x[[1]] <- quote(after_stat)
-        with <- I(glue("`{expr_deparse(x)}`"))
+        with <- I(paste0("`", expr_deparse(x), "`"))
         deprecate_warn0("3.4.0", what, with, id = "ggplot-warn-aes-stat")
       }
       TRUE

R/fortify.R

@@ -74,21 +74,21 @@ validate_as_data_frame <- function(data) {
 
 #' @export
 fortify.default <- function(model, data, ...) {
-  msg0 <- paste0(
-    "{{.arg data}} must be a {{.cls data.frame}}, ",
-    "or an object coercible by {{.fn fortify}}, or a valid ",
-    "{{.cls data.frame}}-like object coercible by {{.fn as.data.frame}}"
+  msg <- paste0(
+    "{.arg data} must be a {.cls data.frame}, ",
+    "or an object coercible by {.fn fortify}, or a valid ",
+    "{.cls data.frame}-like object coercible by {.fn as.data.frame}"
   )
   if (inherits(model, "uneval")) {
     msg <- c(
-      glue(msg0, ", not {obj_type_friendly(model)}."),
+      paste0(msg, ", not ", obj_type_friendly(model), "."),
       "i" = "Did you accidentally pass {.fn aes} to the {.arg data} argument?"
     )
     cli::cli_abort(msg)
   }
-  msg0 <- paste0(msg0, ". ")
+  msg <- paste0(msg, ".")
   try_fetch(
     validate_as_data_frame(model),
-    error = function(cnd) cli::cli_abort(glue(msg0), parent = cnd)
+    error = function(cnd) cli::cli_abort(msg, parent = cnd)
   )
 }

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/ggplot2-package.R

@@ -3,7 +3,6 @@
 
 ## usethis namespace: start
 #' @import scales grid gtable rlang vctrs
-#' @importFrom glue glue glue_collapse
 #' @importFrom lifecycle deprecated
 #' @importFrom stats setNames
 #' @importFrom utils head tail

R/labels.R

@@ -205,40 +205,36 @@ get_alt_text.gtable <- function(p, ...) {
 generate_alt_text <- function(p) {
   # Combine titles
   if (!is.null(p$label$title %||% p$labels$subtitle)) {
-    title <- glue(glue_collapse(
-      sub("\\.?$", "", c(p$labels$title, p$labels$subtitle)),
-      last = ": "
-    ), ". ")
+    title <- sub("\\.?$", "", c(p$labels$title, p$labels$subtitle))
+    if (length(title) == 2) {
+      title <- paste0(title[1], ": ", title[2])
+    }
+    title <- paste0(title, ". ")
     title <- safe_string(title)
   } else {
     title <- ""
   }
 
 
   # Get axes descriptions
-  axes <- glue(" showing ", glue_collapse(
-    c(scale_description(p, "x"), scale_description(p, "y")),
-    last = " and "
-  ))
+  axes <- paste0(" showing ", scale_description(p, "x"), " and ", scale_description(p, "y"))
   axes <- safe_string(axes)
 
   # Get layer types
   layers <- vapply(p$layers, function(l) snake_class(l$geom), character(1))
   layers <- sub("_", " ", sub("^geom_", "", unique0(layers)))
-  layers <- glue(
-    " using ",
-    if (length(layers) == 1) "a " else "",
-    glue_collapse(layers, sep = ", ", last = " and "),
-    " layer",
-    if (length(layers) == 1) "" else "s"
-  )
+  if (length(layers) == 1) {
+    layers <- paste0(" using a ", layers, " layer")
+  } else {
+    layers <- paste0(" using ", oxford_comma(layers), " layers")
+  }
   layers <- safe_string(layers)
 
   # Combine
-  alt <- glue_collapse(
-    c(glue("{title}A plot{axes}{layers}"), p$labels$alt_insight),
-    last = ". "
-  )
+  alt <- paste0(title, "A plot", axes, layers, ".")
+  if (!is.null(p$labels$alt_insight)) {
+    alt <- paste0(alt, " ", p$labels$alt_insight)
+  }
   as.character(alt)
 }
 safe_string <- function(string) {
@@ -258,5 +254,5 @@ scale_description <- function(p, name) {
   if (is.null(lab)) {
     return(NULL)
   }
-  glue("{lab} on {type} {name}-axis")
+  paste0(lab, " on ", type, " ", name, "-axis")
 }

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