Merge branch 'main' into scale_messages

tidyverse · Sep 12, 2023 · 81085eb · 81085eb
2 parents 5071f5e + 0d2023d
commit 81085eb
Show file tree

Hide file tree

Showing 50 changed files with 1,031 additions and 278 deletions.
diff --git a/DESCRIPTION b/DESCRIPTION
@@ -1,5 +1,5 @@
 Package: ggplot2
-Version: 3.4.2.9000
+Version: 3.4.3.9000
 Title: Create Elegant Data Visualisations Using the Grammar of Graphics
 Authors@R: c(
     person("Hadley", "Wickham", , "[email protected]", role = "aut",

diff --git a/NEWS.md b/NEWS.md
@@ -5,6 +5,32 @@
 * The `scale_name` argument in `continuous_scale()`, `discrete_scale()` and
   `binned_scale()` is soft-deprecated (@teunbrand, #1312).
 
+* `stat_ydensity()` with incomplete groups calculates the default `width` 
+  parameter more stably (@teunbrand, #5396)
+
+* `geom_boxplot()` gains a new argument, `staplewidth` that can draw staples
+  at the ends of whiskers (@teunbrand, #5126)
+
+* The `size` argument in `annotation_logticks()` has been deprecated in favour
+  of the `linewidth` argument (#5292).
+
+* `geom_boxplot()` gains an `outliers` argument to switch outliers on or off,
+  in a manner that does affects the scale range. For hiding outliers that does
+  not affect the scale range, you can continue to use `outlier.shape = NA` 
+  (@teunbrand, #4892).
+
+* Binned scales now treat `NA`s in limits the same way continuous scales do 
+  (#5355).
+
+* Binned scales work better with `trans = "reverse"` (#5355).
+
+* The `legend.text.align` and `legend.title.align` arguments in `theme()` are 
+  deprecated. The `hjust` setting of the `legend.text` and `legend.title` 
+  elements continues to fulfil the role of text alignment (@teunbrand, #5347).
+
+* Integers are once again valid input to theme arguments that expect numeric
+  input (@teunbrand, #5369)
+
 * Nicer error messages for xlim/ylim arguments in coord-* functions
   (@92amartins, #4601, #5297).
 
@@ -62,6 +88,10 @@
     * `guide_coloursteps()` and `guide_bins()` sort breaks (#5152).
     * `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
+      of aesthetics is dropped (#5324).
+    * Fixed regression in `guide_legend()` where the `linewidth` key size
+      wasn't adapted to the width of the lines (#5160).
 
 * `geom_label()` now uses the `angle` aesthetic (@teunbrand, #2785)
 * 'lines' units in `geom_label()`, often used in the `label.padding` argument, 
@@ -97,6 +127,10 @@
   duplicated coordinates (@teunbrand, #5215).
 * Improve performance of layers without positional scales (@zeehio, #4990)
 
+# ggplot2 3.4.3
+This hotfix release addresses a version comparison change in r-devel. There are
+no user-facing or breaking changes.
+
 # ggplot2 3.4.2
 This is a hotfix release anticipating changes in r-devel, but folds in upkeep
 changes and a few bug fixes as well.

diff --git a/R/annotation-logticks.R b/R/annotation-logticks.R
@@ -21,11 +21,12 @@
 #'   using `scale_y_log10()`. It should be `FALSE` when using
 #'   `coord_trans(y = "log10")`.
 #' @param colour Colour of the tick marks.
-#' @param size Thickness of tick marks, in mm.
+#' @param linewidth Thickness of tick marks, in mm.
 #' @param linetype Linetype of tick marks (`solid`, `dashed`, etc.)
 #' @param alpha The transparency of the tick marks.
 #' @param color An alias for `colour`.
 #' @param ... Other parameters passed on to the layer
+#' @param size `r lifecycle::badge("deprecated")`
 #'
 #' @export
 #' @seealso [scale_y_continuous()], [scale_y_log10()] for log scale
@@ -81,11 +82,17 @@
 #' )
 annotation_logticks <- function(base = 10, sides = "bl", outside = FALSE, scaled = TRUE,
     short = unit(0.1, "cm"), mid = unit(0.2, "cm"), long = unit(0.3, "cm"),
-    colour = "black", size = 0.5, linetype = 1, alpha = 1, color = NULL, ...)
+    colour = "black", linewidth = 0.5, linetype = 1, alpha = 1, color = NULL, ...,
+    size = deprecated())
 {
   if (!is.null(color))
     colour <- color
 
+  if (lifecycle::is_present(size)) {
+    deprecate_soft0("3.5.0", I("Using the `size` aesthetic in this geom"), I("`linewidth`"))
+    linewidth <- linewidth %||% size
+  }
+
   layer(
     data = dummy_data(),
     mapping = NULL,
@@ -103,7 +110,7 @@ annotation_logticks <- function(base = 10, sides = "bl", outside = FALSE, scaled
       mid = mid,
       long = long,
       colour = colour,
-      size = size,
+      linewidth = linewidth,
       linetype = linetype,
       alpha = alpha,
       ...
@@ -163,14 +170,14 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
         ticks$x_b <- with(data, segmentsGrob(
           x0 = unit(xticks$x, "native"), x1 = unit(xticks$x, "native"),
           y0 = unit(xticks$start, "cm"), y1 = unit(xticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
+          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
         ))
       }
       if (grepl("t", sides) && nrow(xticks) > 0) {
         ticks$x_t <- with(data, segmentsGrob(
           x0 = unit(xticks$x, "native"), x1 = unit(xticks$x, "native"),
           y0 = unit(1, "npc") - unit(xticks$start, "cm"), y1 = unit(1, "npc") - unit(xticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
+          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
         ))
       }
     }
@@ -201,22 +208,22 @@ GeomLogticks <- ggproto("GeomLogticks", Geom,
         ticks$y_l <- with(data, segmentsGrob(
           y0 = unit(yticks$y, "native"), y1 = unit(yticks$y, "native"),
           x0 = unit(yticks$start, "cm"), x1 = unit(yticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
+          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
         ))
       }
       if (grepl("r", sides) && nrow(yticks) > 0) {
         ticks$y_r <- with(data, segmentsGrob(
           y0 = unit(yticks$y, "native"), y1 = unit(yticks$y, "native"),
           x0 = unit(1, "npc") - unit(yticks$start, "cm"), x1 = unit(1, "npc") - unit(yticks$end, "cm"),
-          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = size * .pt)
+          gp = gpar(col = alpha(colour, alpha), lty = linetype, lwd = linewidth * .pt)
         ))
       }
     }
 
     gTree(children = inject(gList(!!!ticks)))
   },
 
-  default_aes = aes(colour = "black", size = 0.5, linetype = 1, alpha = 1)
+  default_aes = aes(colour = "black", linewidth = 0.5, linetype = 1, alpha = 1)
 )
 
 

diff --git a/R/backports.R b/R/backports.R
@@ -1,6 +1,6 @@
 # Backport fix from R 3.3:
 # https://github.com/wch/r-source/commit/4efc81c98d262f93de9e7911aaa910f5c63cd00f
-if (getRversion() < 3.3) {
+if (getRversion() < "3.3") {
   absolute.units <- getFromNamespace("absolute.units", "grid")
   absolute.units.unit <- getFromNamespace("absolute.units.unit", "grid")
   absolute.units.unit.list <- getFromNamespace("absolute.units.unit.list", "grid")
@@ -18,6 +18,6 @@ if (getRversion() < 3.3) {
 on_load(backport_unit_methods())
 
 # isFALSE() is available on R (>=3.5)
-if (getRversion() < 3.5) {
+if (getRversion() < "3.5") {
   isFALSE <- function(x) is.logical(x) && length(x) == 1L && !is.na(x) && !x
 }
diff --git a/R/coord-cartesian-.R b/R/coord-cartesian-.R
@@ -147,37 +147,9 @@ view_scales_from_scale <- function(scale, coord_limits = NULL, expand = TRUE) {
 }
 
 panel_guides_grob <- function(guides, position, theme) {
-  pair <- guide_for_position(guides, position) %||%
-    list(guide = guide_none(), params = NULL)
-  pair$guide$draw(theme, pair$params)
-}
-
-guide_for_position <- function(guides, position) {
-  params <- guides$params
-  has_position <- vapply(
-    params, function(p) identical(p$position, position), logical(1)
-  )
-  if (!any(has_position)) {
-    return(NULL)
-  }
-
-  # Subset guides and parameters
-  guides <- guides$get_guide(has_position)
-  params <- params[has_position]
-  # Pair up guides with parameters
-  pairs <- Map(list, guide = guides, params = params)
-
-  # Early exit, nothing to merge
-  if (length(pairs) == 1) {
-    return(pairs[[1]])
+  if (!inherits(guides, "Guides")) {
+    return(zeroGrob())
   }
-
-  # TODO: There must be a smarter way to merge these
-  order <- order(vapply(params, function(p) as.numeric(p$order), numeric(1)))
-  Reduce(
-    function(old, new) {
-      old$guide$merge(old$params, new$guide, new$params)
-    },
-    pairs[order]
-  )
+  pair <- guides$get_position(position)
+  pair$guide$draw(theme, pair$params)
 }
diff --git a/R/geom-boxplot.R b/R/geom-boxplot.R
@@ -33,25 +33,27 @@
 #' @inheritParams geom_bar
 #' @param geom,stat Use to override the default connection between
 #'   `geom_boxplot()` and `stat_boxplot()`.
+#' @param outliers Whether to display (`TRUE`) or discard (`FALSE`) outliers
+#'   from the plot. Hiding or discarding outliers can be useful when, for
+#'   example, raw data points need to be displayed on top of the boxplot.
+#'   By discarding outliers, the axis limits will adapt to the box and whiskers
+#'   only, not the full data range. If outliers need to be hidden and the axes
+#'   needs to show the full data range, please use `outlier.shape = NA` instead.
 #' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha
 #'   Default aesthetics for outliers. Set to `NULL` to inherit from the
 #'   aesthetics used for the box.
 #'
 #'   In the unlikely event you specify both US and UK spellings of colour, the
 #'   US spelling will take precedence.
 #'
-#'   Sometimes it can be useful to hide the outliers, for example when overlaying
-#'   the raw data points on top of the boxplot. Hiding the outliers can be achieved
-#'   by setting `outlier.shape = NA`. Importantly, this does not remove the outliers,
-#'   it only hides them, so the range calculated for the y-axis will be the
-#'   same with outliers shown and outliers hidden.
-#'
 #' @param notch If `FALSE` (default) make a standard box plot. If
 #'   `TRUE`, make a notched box plot. Notches are used to compare groups;
 #'   if the notches of two boxes do not overlap, this suggests that the medians
 #'   are significantly different.
 #' @param notchwidth For a notched box plot, width of the notch relative to
 #'   the body (defaults to `notchwidth = 0.5`).
+#' @param staplewidth The relative width of staples to the width of the box.
+#'   Staples mark the ends of the whiskers with a line.
 #' @param varwidth If `FALSE` (default) make a standard box plot. If
 #'   `TRUE`, boxes are drawn with widths proportional to the
 #'   square-roots of the number of observations in the groups (possibly
@@ -109,6 +111,7 @@
 geom_boxplot <- function(mapping = NULL, data = NULL,
                          stat = "boxplot", position = "dodge2",
                          ...,
+                         outliers = TRUE,
                          outlier.colour = NULL,
                          outlier.color = NULL,
                          outlier.fill = NULL,
@@ -118,6 +121,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
                          outlier.alpha = NULL,
                          notch = FALSE,
                          notchwidth = 0.5,
+                         staplewidth = 0,
                          varwidth = FALSE,
                          na.rm = FALSE,
                          orientation = NA,
@@ -134,6 +138,9 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
     }
   }
 
+  check_number_decimal(staplewidth)
+  check_bool(outliers)
+
   layer(
     data = data,
     mapping = mapping,
@@ -143,6 +150,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
     show.legend = show.legend,
     inherit.aes = inherit.aes,
     params = list2(
+      outliers = outliers,
       outlier.colour = outlier.color %||% outlier.colour,
       outlier.fill = outlier.fill,
       outlier.shape = outlier.shape,
@@ -151,6 +159,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
       outlier.alpha = outlier.alpha,
       notch = notch,
       notchwidth = notchwidth,
+      staplewidth = staplewidth,
       varwidth = varwidth,
       na.rm = na.rm,
       orientation = orientation,
@@ -167,7 +176,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
 
   # need to declare `width` here in case this geom is used with a stat that
   # doesn't have a `width` parameter (e.g., `stat_identity`).
-  extra_params = c("na.rm", "width", "orientation"),
+  extra_params = c("na.rm", "width", "orientation", "outliers"),
 
   setup_params = function(data, params) {
     params$flipped_aes <- has_flipped_aes(data, params)
@@ -180,6 +189,10 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
     data$width <- data$width %||%
       params$width %||% (resolution(data$x, FALSE) * 0.9)
 
+    if (isFALSE(params$outliers)) {
+      data$outliers <- NULL
+    }
+
     if (!is.null(data$outliers)) {
       suppressWarnings({
         out_min <- vapply(data$outliers, min, numeric(1))
@@ -211,7 +224,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
                         outlier.fill = NULL, outlier.shape = 19,
                         outlier.size = 1.5, outlier.stroke = 0.5,
                         outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5,
-                        varwidth = FALSE, flipped_aes = FALSE) {
+                        staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
     data <- check_linewidth(data, snake_class(self))
     data <- flip_data(data, flipped_aes)
     # this may occur when using geom_boxplot(stat = "identity")
@@ -255,7 +268,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
     )
     box <- flip_data(box, flipped_aes)
 
-    if (!is.null(data$outliers) && length(data$outliers[[1]] >= 1)) {
+    if (!is.null(data$outliers) && length(data$outliers[[1]]) >= 1) {
       outliers <- data_frame0(
         y = data$outliers[[1]],
         x = data$x[1],
@@ -275,8 +288,28 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
       outliers_grob <- NULL
     }
 
+    if (staplewidth != 0) {
+      staples <- data_frame0(
+        x    = rep((data$xmin - data$x) * staplewidth + data$x, 2),
+        xend = rep((data$xmax - data$x) * staplewidth + data$x, 2),
+        y    = c(data$ymax, data$ymin),
+        yend = c(data$ymax, data$ymin),
+        alpha = c(NA_real_, NA_real_),
+        !!!common,
+        .size = 2
+      )
+      staples <- flip_data(staples, flipped_aes)
+      staple_grob <- GeomSegment$draw_panel(
+        staples, panel_params, coord,
+        lineend = lineend
+      )
+    } else {
+      staple_grob <- NULL
+    }
+
     ggname("geom_boxplot", grobTree(
       outliers_grob,
+      staple_grob,
       GeomSegment$draw_panel(whiskers, panel_params, coord, lineend = lineend),
       GeomCrossbar$draw_panel(
         box,