integrate with main

Merge branch 'main' into guide_positioning

# Conflicts:
#	R/guides-.R
#	R/plot-build.R

Author: teunbrand

DESCRIPTION

@@ -59,12 +59,12 @@ Suggests:
     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

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

R/guide-axis.R

@@ -14,6 +14,8 @@
 #' @param n.dodge The number of rows (for vertical axes) or columns (for
 #'   horizontal axes) that should be used to render the labels. This is
 #'   useful for displaying labels that would otherwise overlap.
+#' @param minor.ticks Whether to draw the minor ticks (`TRUE`) or not draw
+#'   minor ticks (`FALSE`, default).
 #' @param cap A `character` to cut the axis line back to the last breaks. Can
 #'   be `"none"` (default) to draw the axis line along the whole panel, or
 #'   `"upper"` and `"lower"` to draw the axis to the upper or lower break, or
@@ -42,23 +44,23 @@
 #' # can also be used to add a duplicate guide
 #' p + guides(x = guide_axis(n.dodge = 2), y.sec = guide_axis())
 guide_axis <- function(title = waiver(), check.overlap = FALSE, angle = NULL,
-                       n.dodge = 1, cap = "none", order = 0,
-                       position = waiver()) {
-
+                       n.dodge = 1, minor.ticks = FALSE, cap = "none",
+                       order = 0, position = waiver()) {
+  check_bool(minor.ticks)
   if (is.logical(cap)) {
     check_bool(cap)
     cap <- if (cap) "both" else "none"
   }
   cap <- arg_match0(cap, c("none", "both", "upper", "lower"))
 
-
   new_guide(
     title = title,
 
     # customisations
     check.overlap = check.overlap,
     angle = angle,
     n.dodge = n.dodge,
+    minor.ticks = minor.ticks,
     cap = cap,
 
     # parameter
@@ -87,6 +89,7 @@ GuideAxis <- ggproto(
     direction = NULL,
     angle     = NULL,
     n.dodge   = 1,
+    minor.ticks = FALSE,
     cap       = "none",
     order     = 0,
     check.overlap = FALSE
@@ -100,9 +103,37 @@ GuideAxis <- ggproto(
     line  = "axis.line",
     text  = "axis.text",
     ticks = "axis.ticks",
-    ticks_length = "axis.ticks.length"
+    minor = "axis.minor.ticks",
+    major_length = "axis.ticks.length",
+    minor_length = "axis.minor.ticks.length"
   ),
 
+  extract_key = function(scale, aesthetic, minor.ticks, ...) {
+    major <- Guide$extract_key(scale, aesthetic, ...)
+    if (!minor.ticks) {
+      return(major)
+    }
+
+    minor_breaks <- scale$get_breaks_minor()
+    minor_breaks <- setdiff(minor_breaks, major$.value)
+    minor_breaks <- minor_breaks[is.finite(minor_breaks)]
+
+    if (length(minor_breaks) < 1) {
+      return(major)
+    }
+
+    minor <- data_frame0(!!aesthetic := scale$map(minor_breaks))
+    minor$.value <- minor_breaks
+    minor$.type <- "minor"
+
+    if (nrow(major) > 0) {
+      major$.type <- "major"
+      vec_rbind(major, minor)
+    } else {
+      minor
+    }
+  },
+
   extract_params = function(scale, params, ...) {
     params$name <- paste0(params$name, "_", params$aesthetic)
     params
@@ -185,7 +216,7 @@ GuideAxis <- ggproto(
   },
 
   setup_elements = function(params, elements, theme) {
-    axis_elem <- c("line", "text", "ticks", "ticks_length")
+    axis_elem <- c("line", "text", "ticks", "minor", "major_length", "minor_length")
     is_char  <- vapply(elements[axis_elem], is.character, logical(1))
     axis_elem <- axis_elem[is_char]
     elements[axis_elem] <- lapply(
@@ -225,26 +256,17 @@ GuideAxis <- ggproto(
       "horizontal"
     }
 
-    # TODO: delete following comment at some point:
-    # I found the 'position_*'/'non-position_*' and '*_dim' names confusing.
-    # For my own understanding, these have been renamed as follows:
-    # * 'aes' and 'orth_aes' for the aesthetic direction and the direction
-    #   orthogonal to the aesthetic direction, respectively.
-    # * 'para_sizes' and 'orth_size(s)' for the dimension parallel to the
-    #   aesthetic and orthogonal to the aesthetic respectively.
-    # I also tried to trim down the verbosity of the variable names a bit
-
     new_params <- c("aes", "orth_aes", "para_sizes", "orth_size", "orth_sizes",
                     "vertical", "measure_gtable", "measure_text")
     if (direction == "vertical") {
       params[new_params] <- list(
         "y", "x", "heights", "width", "widths",
-        TRUE, gtable_width, grobWidth
+        TRUE, gtable_width, width_cm
       )
     } else {
       params[new_params] <- list(
         "x", "y", "widths", "height", "heights",
-        FALSE, gtable_height, grobHeight
+        FALSE, gtable_height, height_cm
       )
     }
 
@@ -275,7 +297,32 @@ GuideAxis <- ggproto(
     )
   },
 
+  build_ticks = function(key, elements, params, position = params$opposite) {
+
+    major <- Guide$build_ticks(
+      vec_slice(key, (key$.type %||% "major") == "major"),
+      elements$ticks, params, position,
+      elements$major_length
+    )
+
+    if (!params$minor.ticks) {
+      return(major)
+    }
+
+    minor <- Guide$build_ticks(
+      vec_slice(key, (key$.type %||% "major") == "minor"),
+      elements$minor, params, position,
+      elements$minor_length
+    )
+    grobTree(major, minor, name = "ticks")
+  },
+
   build_labels = function(key, elements, params) {
+
+    if (".type" %in% names(key)) {
+      key <- vec_slice(key, key$.type == "major")
+    }
+
     labels   <- validate_labels(key$.label)
     n_labels <- length(labels)
 
@@ -309,10 +356,20 @@ GuideAxis <- ggproto(
 
     measure <- params$measure_text
 
-    length <- elements$ticks_length
-    spacer <- max(unit(0, "pt"), -1 * length)
-    labels <- do.call(unit.c, lapply(grobs$labels, measure))
-    title  <- measure(grobs$title)
+    # Ticks
+    major_cm <- convertUnit(elements$major_length, "cm", valueOnly = TRUE)
+    range <- range(0, major_cm)
+    if (params$minor.ticks && !inherits(elements$minor, "element_blank")) {
+      minor_cm <- convertUnit(elements$minor_length, "cm", valueOnly = TRUE)
+      range <- range(range, minor_cm)
+    }
+
+    length <- unit(range[2], "cm")
+    spacer <- max(unit(0, "pt"), unit(-1 * diff(range), "cm"))
+
+    # Text
+    labels <- unit(measure(grobs$label), "cm")
+    title  <- unit(measure(grobs$title), "cm")
 
     sizes <- unit.c(length, spacer, labels, title)
     if (params$lab_first) {
@@ -429,7 +486,7 @@ draw_axis <- function(break_positions, break_labels, axis_position, theme,
     !!aes := c(0, 1),
     !!opp := opp_value
   )
-  guide$draw(theme, params)
+  guide$draw(theme, params = params)
 }
 
 draw_axis_labels <- function(break_positions, break_labels, label_element, is_vertical,