Merge branch 'angle_heuristic' of https://github.com/teunbrand/ggplot2 …

…into angle_heuristic

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

@@ -4,6 +4,18 @@
   argument to overrule theme settings, similar to `guide_axis(angle)` 
   (@teunbrand, #4594).
 * (internal) rearranged the code of `Facet$draw_paensl()` method (@teunbrand).
+* 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)
+* Bare numeric values provided to Date or Datetime scales get inversely 
+  transformed (cast to Date/POSIXct) with a warning (@teunbrand).
+* `stat_bin()` now accepts functions for argument `breaks` (@aijordan, #4561)
+* (internal) The plot's layout now has a coord parameter that is used to 
+  prevent setting up identical panel parameters (#5427)
+* (internal) rearranged the code of `Facet$draw_panels()` method (@teunbrand).
 * `geom_rug()` prints a warning when `na.rm = FALSE`, as per documentation (@pn317, #5905)
 * `position_dodge(preserve = "single")` now handles multi-row geoms better,
   such as `geom_violin()` (@teunbrand based on @clauswilke's work, #2801).
@@ -99,6 +111,8 @@
   the `nbin` argument (@teunbrand, #5882, #5036)
 * `after_stat()` and `after_scale()` throw warnings when the computed aesthetics
   are not of the correct length (#5901).
+* `geom_hline()` and `geom_vline()` now have `position` argument
+  (@yutannihilation, #4285).
 
 # ggplot2 3.5.1
 

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/coord-.R

@@ -196,6 +196,11 @@ Coord <- ggproto("Coord",
   },
 
   setup_layout = function(layout, params) {
+    # We're appending a COORD variable to the layout that determines the
+    # uniqueness of panel parameters. The layout uses this to prevent redundant
+    # setups of these parameters.
+    scales <- layout[c("SCALE_X", "SCALE_Y")]
+    layout$COORD <- vec_match(scales, unique0(scales))
     layout
   },
 

R/coord-flip.R

@@ -99,6 +99,7 @@ CoordFlip <- ggproto("CoordFlip", CoordCartesian,
   },
 
   setup_layout = function(layout, params) {
+    layout <- Coord$setup_layout(layout, params)
     # Switch the scales
     layout[c("SCALE_X", "SCALE_Y")] <- layout[c("SCALE_Y", "SCALE_X")]
     layout

R/fortify.R

@@ -17,10 +17,7 @@ fortify.data.frame <- function(model, data, ...) model
 #' @export
 fortify.tbl_df <- function(model, data, ...) model
 #' @export
-fortify.tbl <- function(model, data, ...) {
-  check_installed("dplyr", reason = "to work with `tbl` objects.")
-  dplyr::collect(model)
-}
+fortify.tbl <- function(model, data, ...) as.data.frame(model)
 #' @export
 fortify.NULL <- function(model, data, ...) waiver()
 #' @export
@@ -77,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-hline.R

@@ -4,6 +4,7 @@ NULL
 #' @export
 #' @rdname geom_abline
 geom_hline <- function(mapping = NULL, data = NULL,
+                       position = "identity",
                        ...,
                        yintercept,
                        na.rm = FALSE,
@@ -29,7 +30,7 @@ geom_hline <- function(mapping = NULL, data = NULL,
     mapping = mapping,
     stat = StatIdentity,
     geom = GeomHline,
-    position = PositionIdentity,
+    position = position,
     show.legend = show.legend,
     inherit.aes = FALSE,
     params = list2(

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/geom-vline.R

@@ -4,6 +4,7 @@ NULL
 #' @export
 #' @rdname geom_abline
 geom_vline <- function(mapping = NULL, data = NULL,
+                       position = "identity",
                        ...,
                        xintercept,
                        na.rm = FALSE,
@@ -29,7 +30,7 @@ geom_vline <- function(mapping = NULL, data = NULL,
     mapping = mapping,
     stat = StatIdentity,
     geom = GeomVline,
-    position = PositionIdentity,
+    position = position,
     show.legend = show.legend,
     inherit.aes = FALSE,
     params = list2(

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