Merge branch 'main' into expose_xseq

DESCRIPTION

@@ -1,5 +1,5 @@
 Package: ggplot2
-Version: 3.4.3.9000
+Version: 3.4.4.9000
 Title: Create Elegant Data Visualisations Using the Grammar of Graphics
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = "aut",
@@ -54,18 +54,17 @@ Suggests:
     knitr,
     mapproj,
     maps,
-    maptools,
     multcomp,
     munsell,
     nlme,
     profvis,
     quantreg,
-    ragg,
+    ragg (>= 1.2.6),
     RColorBrewer,
     rmarkdown,
     rpart,
     sf (>= 0.7-3),
-    svglite (>= 1.2.0.9001),
+    svglite (>= 2.1.2),
     testthat (>= 3.1.2),
     vdiffr (>= 1.0.6),
     xml2

NEWS.md

@@ -1,5 +1,16 @@
 # ggplot2 (development version)
 
+* `ggsave()` no longer sometimes creates new directories, which is now 
+  controlled by the new `create.dir` argument (#5489).
+
+* `guide_coloursteps(even.steps = FALSE)` now draws one rectangle per interval
+  instead of many small ones (#5481).
+
+* (internal) guide building is now part of `ggplot_build()` instead of 
+  `ggplot_gtable()` to allow guides to observe unmapped data (#5483).
+
+* `geom_violin()` gains a `bounds` argument analogous to `geom_density()`s (@eliocamp, #5493).
+
 * Legend titles no longer take up space if they've been removed by setting 
   `legend.title = element_blank()` (@teunbrand, #3587).
 
@@ -114,6 +125,7 @@
     * More informative error for mismatched 
      `direction`/`theme(legend.direction = ...)` arguments (#4364, #4930).
     * `guide_coloursteps()` and `guide_bins()` sort breaks (#5152).
+    * `guide_axis()` gains a `minor.ticks` argument to draw minor ticks (#4387).
     * `guide_axis()` gains a `cap` argument that can be used to trim the
       axis line to extreme breaks (#4907).
     * `guide_colourbar()` and `guide_coloursteps()` merge properly when one
@@ -155,6 +167,17 @@
   duplicated coordinates (@teunbrand, #5215).
 * Improve performance of layers without positional scales (@zeehio, #4990)
 
+# ggplot2 3.4.4
+
+This hotfix release adapts to a change in r-devel's `base::is.atomic()` and 
+the upcoming retirement of maptools.
+
+* `fortify()` for sp objects (e.g., `SpatialPolygonsDataFrame`) is now deprecated
+  and will be removed soon in support of [the upcoming retirement of rgdal, rgeos,
+  and maptools](https://r-spatial.org/r/2023/05/15/evolution4.html). In advance
+  of the whole removal, `fortify(<SpatialPolygonsDataFrame>, region = ...)`
+  no longer works as of this version (@yutannihilation, #5244).
+
 # ggplot2 3.4.3
 This hotfix release addresses a version comparison change in r-devel. There are
 no user-facing or breaking changes.

R/aes-evaluation.R

@@ -226,7 +226,7 @@ is_calculated <- function(x, warn = FALSE) {
     return(TRUE)
   }
   # Support of old recursive behaviour
-  if (is.atomic(x)) {
+  if (is.null(x) || is.atomic(x)) {
     FALSE
   } else if (is.symbol(x)) {
     res <- is_dotted_var(as.character(x))
@@ -266,7 +266,7 @@ is_staged <- function(x) {
 
 # Strip dots from expressions
 strip_dots <- function(expr, env, strip_pronoun = FALSE) {
-  if (is.atomic(expr)) {
+  if (is.null(expr) || is.atomic(expr)) {
     expr
   } else if (is.name(expr)) {
     expr_ch <- as.character(expr)
@@ -324,7 +324,7 @@ strip_stage <- function(expr) {
 make_labels <- function(mapping) {
   default_label <- function(aesthetic, mapping) {
     # e.g., geom_smooth(aes(colour = "loess")) or aes(y = NULL)
-    if (is.atomic(mapping)) {
+    if (is.null(mapping) || is.atomic(mapping)) {
       return(aesthetic)
     }
     mapping <- strip_stage(mapping)

R/aes.R

@@ -285,7 +285,7 @@ aes_ <- function(x, y, ...) {
   as_quosure_aes <- function(x) {
     if (is.formula(x) && length(x) == 2) {
       as_quosure(x)
-    } else if (is.call(x) || is.name(x) || is.atomic(x)) {
+    } else if (is.null(x) || is.call(x) || is.name(x) || is.atomic(x)) {
       new_aesthetic(x, caller_env)
     } else {
       cli::cli_abort("Aesthetic must be a one-sided formula, call, name, or constant.")

R/annotation.R

@@ -14,7 +14,7 @@
 #' @section Unsupported geoms:
 #' Due to their special nature, reference line geoms [geom_abline()],
 #' [geom_hline()], and [geom_vline()] can't be used with [annotate()].
-#' You can use these geoms directory for annotations.
+#' You can use these geoms directly for annotations.
 #' @param geom name of geom to use for annotation
 #' @param x,y,xmin,ymin,xmax,ymax,xend,yend positioning aesthetics -
 #'   you must specify at least one of these.

R/coord-cartesian-.R

@@ -151,5 +151,5 @@ panel_guides_grob <- function(guides, position, theme) {
     return(zeroGrob())
   }
   pair <- guides$get_position(position)
-  pair$guide$draw(theme, pair$params)
+  pair$guide$draw(theme, params = pair$params)
 }

R/coord-sf.R

@@ -93,8 +93,8 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
     # transform and normalize regular position data
     data <- transform_position(
       sf_transform_xy(data, target_crs, source_crs),
-      function(x) sf_rescale01_x(x, panel_params$x_range),
-      function(x) sf_rescale01_x(x, panel_params$y_range)
+      function(x) rescale(x, from = panel_params$x_range),
+      function(x) rescale(x, from = panel_params$y_range)
     )
 
     transform_position(data, squish_infinite, squish_infinite)
@@ -250,10 +250,10 @@ CoordSf <- ggproto("CoordSf", CoordCartesian,
 
     # Rescale graticule for panel grid
     sf::st_geometry(graticule) <- sf_rescale01(sf::st_geometry(graticule), x_range, y_range)
-    graticule$x_start <- sf_rescale01_x(graticule$x_start, x_range)
-    graticule$x_end <- sf_rescale01_x(graticule$x_end, x_range)
-    graticule$y_start <- sf_rescale01_x(graticule$y_start, y_range)
-    graticule$y_end <- sf_rescale01_x(graticule$y_end, y_range)
+    graticule$x_start <- rescale(graticule$x_start, from = x_range)
+    graticule$x_end   <- rescale(graticule$x_end,   from = x_range)
+    graticule$y_start <- rescale(graticule$y_start, from = y_range)
+    graticule$y_end   <- rescale(graticule$y_end,   from = y_range)
 
     list2(
       x_range = x_range,
@@ -405,11 +405,6 @@ sf_rescale01 <- function(x, x_range, y_range) {
   sf::st_normalize(x, c(x_range[1], y_range[1], x_range[2], y_range[2]))
 }
 
-# normalize position data (variable x is x or y position)
-sf_rescale01_x <- function(x, range) {
-  (x - range[1]) / diff(range)
-}
-
 # different limits methods
 calc_limits_bbox <- function(method, xlim, ylim, crs, default_crs) {
   if (any(!is.finite(c(xlim, ylim))) && method != "geometry_bbox") {

R/fortify-spatial.R

@@ -9,32 +9,31 @@
 #' @param ... not used by this method
 #' @keywords internal
 #' @name fortify.sp
-#' @examples
-#' if (require("maptools")) {
-#'  sids <- system.file("shapes/sids.shp", package="maptools")
-#'  nc1 <- readShapePoly(sids,
-#'    proj4string = CRS("+proj=longlat +datum=NAD27"))
-#'  nc1_df <- fortify(nc1)
-#' }
 NULL
 
 #' @rdname fortify.sp
 #' @export
 #' @method fortify SpatialPolygonsDataFrame
 fortify.SpatialPolygonsDataFrame <- function(model, data, region = NULL, ...) {
+  deprecate_warn0("3.4.4",
+    I("`fortify(<SpatialPolygonsDataFrame>)`"),
+    details = "Please migrate to sf."
+  )
+
   attr <- as.data.frame(model)
   # If not specified, split into regions based on polygons
   if (is.null(region)) {
-    coords <- lapply(model@polygons,fortify)
+    # Suppress duplicated warnings
+    withr::with_options(list(lifecycle_verbosity = "quiet"), {
+      coords <- lapply(model@polygons,fortify)
+    })
     coords <- vec_rbind0(!!!coords)
     cli::cli_inform("Regions defined for each Polygons")
   } else {
-    cp <- sp::polygons(model)
-
-    # Union together all polygons that make up a region
-    unioned <- maptools::unionSpatialPolygons(cp, attr[, region])
-    coords <- fortify(unioned)
-    coords$order <- 1:nrow(coords)
+    lifecycle::deprecate_stop("3.4.4",
+      I("`fortify(<SpatialPolygonsDataFrame>, region = ...)` is defunct'"),
+      details = "Please migrate to sf."
+    )
   }
   coords
 }
@@ -43,14 +42,27 @@ fortify.SpatialPolygonsDataFrame <- function(model, data, region = NULL, ...) {
 #' @export
 #' @method fortify SpatialPolygons
 fortify.SpatialPolygons <- function(model, data, ...) {
-  polys <- lapply(model@polygons, fortify)
+  deprecate_warn0("3.4.4",
+    I("`fortify(<SpatialPolygons>)`"),
+    details = "Please migrate to sf."
+  )
+
+  # Suppress duplicated warnings
+  withr::with_options(list(lifecycle_verbosity = "quiet"), {
+    polys <- lapply(model@polygons, fortify)
+  })
   vec_rbind0(!!!polys)
 }
 
 #' @rdname fortify.sp
 #' @export
 #' @method fortify Polygons
 fortify.Polygons <- function(model, data, ...) {
+  deprecate_warn0("3.4.4",
+    I("`fortify(<Polygons>)`"),
+    details = "Please migrate to sf."
+  )
+
   subpolys <- model@Polygons
   pieces <- lapply(seq_along(subpolys), function(i) {
     df <- fortify(subpolys[[model@plotOrder[i]]])
@@ -70,6 +82,11 @@ fortify.Polygons <- function(model, data, ...) {
 #' @export
 #' @method fortify Polygon
 fortify.Polygon <- function(model, data, ...) {
+  deprecate_warn0("3.4.4",
+    I("`fortify(<Polygon>)`"),
+    details = "Please migrate to sf."
+  )
+
   df <- as.data.frame(model@coords)
   names(df) <- c("long", "lat")
   df$order <- 1:nrow(df)
@@ -81,6 +98,11 @@ fortify.Polygon <- function(model, data, ...) {
 #' @export
 #' @method fortify SpatialLinesDataFrame
 fortify.SpatialLinesDataFrame <- function(model, data, ...) {
+  deprecate_warn0("3.4.4",
+    I("`fortify(<SpatialLinesDataFrame>)`"),
+    details = "Please migrate to sf."
+  )
+
   lines <- lapply(model@lines, fortify)
   vec_rbind0(!!!lines)
 }
@@ -89,6 +111,11 @@ fortify.SpatialLinesDataFrame <- function(model, data, ...) {
 #' @export
 #' @method fortify Lines
 fortify.Lines <- function(model, data, ...) {
+  deprecate_warn0("3.4.4",
+    I("`fortify(<Lines>)`"),
+    details = "Please migrate to sf."
+  )
+
   lines <- model@Lines
   pieces <- lapply(seq_along(lines), function(i) {
     df <- fortify(lines[[i]])
@@ -108,6 +135,11 @@ fortify.Lines <- function(model, data, ...) {
 #' @export
 #' @method fortify Line
 fortify.Line <- function(model, data, ...) {
+  deprecate_warn0("3.4.4",
+    I("`fortify(<Line>)`"),
+    details = "Please migrate to sf."
+  )
+
   df <- as.data.frame(model@coords)
   names(df) <- c("long", "lat")
   df$order <- 1:nrow(df)

R/geom-violin.R

@@ -16,6 +16,11 @@
 #'   to the range of the data. If `FALSE`, don't trim the tails.
 #' @param geom,stat Use to override the default connection between
 #'   `geom_violin()` and `stat_ydensity()`.
+#' @param bounds Known lower and upper bounds for estimated data. Default
+#'   `c(-Inf, Inf)` means that there are no (finite) bounds. If any bound is
+#'   finite, boundary effect of default density estimation will be corrected by
+#'   reflecting tails outside `bounds` around their closest edge. Data points
+#'   outside of bounds are removed with a warning.
 #' @export
 #' @references Hintze, J. L., Nelson, R. D. (1998) Violin Plots: A Box
 #' Plot-Density Trace Synergism. The American Statistician 52, 181-184.
@@ -86,6 +91,7 @@ geom_violin <- function(mapping = NULL, data = NULL,
                         ...,
                         draw_quantiles = NULL,
                         trim = TRUE,
+                        bounds = c(-Inf, Inf),
                         scale = "area",
                         na.rm = FALSE,
                         orientation = NA,
@@ -105,6 +111,7 @@ geom_violin <- function(mapping = NULL, data = NULL,
       draw_quantiles = draw_quantiles,
       na.rm = na.rm,
       orientation = orientation,
+      bounds = bounds,
       ...
     )
   )

R/guide-.R

@@ -117,9 +117,12 @@ new_guide <- function(..., available_aes = "any", super) {
 #'   `params$hash`. This ensures that e.g. `guide_legend()` can display both
 #'   `shape` and `colour` in the same guide.
 #'
-#' - `get_layer_key()` Extract information from layers. This can be used to
-#'   check that the guide's aesthetic is actually in use, or to gather
-#'   information about how legend keys should be displayed.
+#' - `process_layers()` Extract information from layers. This acts mostly
+#'   as a filter for which layers to include and these are then (typically)
+#'   forwarded to `get_layer_key()`.
+#'
+#' - `get_layer_key()` This can be used to gather information about how legend
+#'   keys should be displayed.
 #'
 #' - `setup_params()` Set up parameters at the beginning of drawing stages.
 #'   It can be used to overrule user-supplied parameters or perform checks on
@@ -253,7 +256,11 @@ Guide <- ggproto(
 
   # Function for extracting information from the layers.
   # Mostly applies to `guide_legend()` and `guide_binned()`
-  get_layer_key = function(params, layers) {
+  process_layers = function(self, params, layers, data = NULL) {
+    self$get_layer_key(params, layers, data)
+  },
+
+  get_layer_key = function(params, layers, data = NULL) {
     return(params)
   },
 
@@ -280,11 +287,14 @@ Guide <- ggproto(
 
   # Main drawing function that organises more specialised aspects of guide
   # drawing.
-  draw = function(self, theme, params = self$params) {
+  draw = function(self, theme, position = NULL, direction = NULL,
+                  params = self$params) {
 
     key <- params$key
 
     # Setup parameters and theme
+    params$position  <- params$position  %||% position
+    params$direction <- params$direction %||% direction
     params <- self$setup_params(params)
     elems  <- self$setup_elements(params, self$elements, theme)
     elems  <- self$override_elements(params, elems, theme)
@@ -351,7 +361,14 @@ Guide <- ggproto(
   },
 
   # Renders tickmarks
-  build_ticks = function(key, elements, params, position = params$position) {
+  build_ticks = function(key, elements, params, position = params$position,
+                         length = elements$ticks_length) {
+    if (!inherits(elements, "element")) {
+      elements <- elements$ticks
+    }
+    if (!inherits(elements, "element_line")) {
+      return(zeroGrob())
+    }
 
     if (!is.list(key)) {
       breaks <- key
@@ -365,8 +382,7 @@ Guide <- ggproto(
       return(zeroGrob())
     }
 
-    tick_len <- rep(elements$ticks_length %||% unit(0.2, "npc"),
-                    length.out = n_breaks)
+    tick_len <- rep(length %||% unit(0.2, "npc"), length.out = n_breaks)
 
     # Resolve mark
     mark <- unit(rep(breaks, each = 2), "npc")
@@ -375,12 +391,12 @@ Guide <- ggproto(
     pos <- unname(c(top = 1, bottom = 0, left = 0, right = 1)[position])
     dir <- -2 * pos + 1
     pos <- unit(rep(pos, 2 * n_breaks), "npc")
-    dir <- rep(vec_interleave(0, dir), n_breaks) * tick_len
+    dir <- rep(vec_interleave(dir, 0), n_breaks) * tick_len
     tick <- pos + dir
 
     # Build grob
     flip_element_grob(
-      elements$ticks,
+      elements,
       x = tick, y = mark,
       id.lengths = rep(2, n_breaks),
       flip = position %in% c("top", "bottom")