Merge branch 'main' into missing_linewidth_scales

Author: teunbrand

NEWS.md

@@ -2,12 +2,18 @@
 
 * Added `scale_linewidth_manual()` and `scale_linewidth_identity()` to support
   the `linewidth` aesthetic (@teunbrand, #5050).
+* Automatic breaks in `scale_*_binned()` should no longer be out-of-bounds,
+  and automatic limits expand to include these (@teunbrand, #5095, #5100).
+* Renamed computed aesthetic in `stat_ecdf()` to `ecdf`, to prevent incorrect
+  scale transformations (@teunbrand, #5113 and #5112).
+* Fixed misbehaviour of `draw_key_boxplot()` and `draw_key_crossbar()` with 
+  skewed key aspect ratio (@teunbrand, #5082).
 * `scale_*_binned()` handles zero-range limits more gracefully (@teunbrand, 
   #5066)
 * Binned scales are now compatible with `trans = "date"` and `trans = "time"` 
   (@teunbrand, #4217).
 * `ggsave()` warns when multiple `filename`s are given, and only writes to the
-  first file (@teunbrand, #5114).
+  first file (@teunbrand, #5114)
 * Fixed a regression in `geom_hex()` where aesthetics were replicated across 
   bins (@thomasp85, #5037 and #5044)
 * Fixed spurious warning when `weight` aesthetic was used in `stat_smooth()` 

R/legend-draw.r

@@ -98,39 +98,58 @@ draw_key_blank <- function(data, params, size) {
 #' @export
 #' @rdname draw_key
 draw_key_boxplot <- function(data, params, size) {
-  grobTree(
-    linesGrob(0.5, c(0.1, 0.25)),
-    linesGrob(0.5, c(0.75, 0.9)),
-    rectGrob(height = 0.5, width = 0.75),
-    linesGrob(c(0.125, 0.875), 0.5),
-    gp = gpar(
-      col = data$colour %||% "grey20",
-      fill = alpha(data$fill %||% "white", data$alpha),
-      lwd = (data$linewidth %||% 0.5) * .pt,
-      lty = data$linetype %||% 1,
-      lineend = params$lineend %||% "butt",
-      linejoin = params$linejoin %||% "mitre"
-    ),
-    vp = if (isTRUE(params$flipped_aes)) viewport(angle = -90)
+  gp <- gpar(
+    col = data$colour %||% "grey20",
+    fill = alpha(data$fill %||% "white", data$alpha),
+    lwd = (data$linewidth %||% 0.5) * .pt,
+    lty = data$linetype %||% 1,
+    lineend = params$lineend %||% "butt",
+    linejoin = params$linejoin %||% "mitre"
   )
+
+  if (isTRUE(params$flipped_aes)) {
+    grobTree(
+      linesGrob(c(0.1, 0.25), 0.5),
+      linesGrob(c(0.75, 0.9), 0.5),
+      rectGrob(width = 0.5, height = 0.75),
+      linesGrob(0.5, c(0.125, 0.875)),
+      gp = gp
+    )
+  } else {
+    grobTree(
+      linesGrob(0.5, c(0.1, 0.25)),
+      linesGrob(0.5, c(0.75, 0.9)),
+      rectGrob(height = 0.5, width = 0.75),
+      linesGrob(c(0.125, 0.875), 0.5),
+      gp = gp
+    )
+  }
 }
 
 #' @export
 #' @rdname draw_key
 draw_key_crossbar <- function(data, params, size) {
-  grobTree(
-    rectGrob(height = 0.5, width = 0.75),
-    linesGrob(c(0.125, 0.875), 0.5),
-    gp = gpar(
-      col = data$colour %||% "grey20",
-      fill = alpha(data$fill %||% "white", data$alpha),
-      lwd = (data$linewidth %||% 0.5) * .pt,
-      lty = data$linetype %||% 1,
-      lineend = params$lineend %||% "butt",
-      linejoin = params$linejoin %||% "mitre"
-    ),
-    vp = if (isTRUE(params$flipped_aes)) viewport(angle = -90)
+  gp <- gpar(
+    col = data$colour %||% "grey20",
+    fill = alpha(data$fill %||% "white", data$alpha),
+    lwd = (data$linewidth %||% 0.5) * .pt,
+    lty = data$linetype %||% 1,
+    lineend = params$lineend %||% "butt",
+    linejoin = params$linejoin %||% "mitre"
   )
+  if (isTRUE(params$flipped_aes)) {
+    grobTree(
+      rectGrob(height = 0.75, width = 0.5),
+      linesGrob(0.5, c(0.125, 0.875)),
+      gp = gp
+    )
+  } else {
+    grobTree(
+      rectGrob(height = 0.5, width = 0.75),
+      linesGrob(c(0.125, 0.875), 0.5),
+      gp = gp
+    )
+  }
 }
 
 #' @export

R/scale-.r

@@ -1077,6 +1077,7 @@ ScaleBinned <- ggproto("ScaleBinned", Scale,
         breaks <- seq(limits[1], limits[2], length.out = n.breaks + 2)
         breaks <- breaks[-c(1, length(breaks))]
       }
+      breaks <- oob_discard(breaks, limits)
 
       # Ensure terminal bins are same width if limits not set
       if (is.null(self$limits)) {

R/scale-binned.R

@@ -70,6 +70,7 @@ ScaleBinnedPosition <- ggproto("ScaleBinnedPosition", ScaleBinned,
 
   map = function(self, x, limits = self$get_limits()) {
     breaks <- self$get_breaks(limits)
+    limits <- self$get_limits() # get_breaks() may have updated this
     all_breaks <- unique0(sort(c(limits[1], breaks, limits[2])))
 
     if (self$after.stat) {

R/stat-bin.r

@@ -123,9 +123,6 @@ StatBin <- ggproto("StatBin", Stat,
       params$closed <- if (params$right) "right" else "left"
       params$right <- NULL
     }
-    if (!is.null(params$width)) {
-      deprecate_warn0("2.1.0", "stat_bin(width)", "geom_bar()")
-    }
     if (!is.null(params$boundary) && !is.null(params$center)) {
       cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified in {.fn {snake_class(self)}}.")
     }
@@ -146,8 +143,7 @@ StatBin <- ggproto("StatBin", Stat,
                            breaks = NULL, flipped_aes = FALSE,
                            # The following arguments are not used, but must
                            # be listed so parameters are computed correctly
-                           origin = NULL, right = NULL, drop = NULL,
-                           width = NULL) {
+                           origin = NULL, right = NULL, drop = NULL) {
     x <- flipped_names(flipped_aes)$x
     if (!is.null(breaks)) {
       if (!scales[[x]]$is_discrete()) {

R/stat-ecdf.r

@@ -21,7 +21,7 @@
 #' @param pad If `TRUE`, pad the ecdf with additional points (-Inf, 0)
 #'   and (Inf, 1)
 #' @eval rd_computed_vars(
-#'   y = "Cumulative density corresponding to `x`."
+#'   ecdf = "Cumulative density corresponding to `x`."
 #' )
 #' @export
 #' @examples
@@ -73,7 +73,7 @@ stat_ecdf <- function(mapping = NULL, data = NULL,
 StatEcdf <- ggproto("StatEcdf", Stat,
   required_aes = c("x|y"),
 
-  default_aes = aes(y = after_stat(y)),
+  default_aes = aes(x = after_stat(ecdf), y = after_stat(ecdf)),
 
   setup_params = function(self, data, params) {
     params$flipped_aes <- has_flipped_aes(data, params, main_is_orthogonal = FALSE, main_is_continuous = TRUE)
@@ -103,7 +103,7 @@ StatEcdf <- ggproto("StatEcdf", Stat,
 
     df_ecdf <- data_frame0(
       x = x,
-      y = data_ecdf,
+      ecdf = data_ecdf,
       .size = length(x)
     )
     df_ecdf$flipped_aes <- flipped_aes

man/stat_ecdf.Rd

@@ -5,6 +5,45 @@ test_that("binned scales only support continuous data", {
   expect_snapshot_error(ggplot_build(p))
 })
 
+test_that("binned scales limits can expand to fit breaks", {
+  # See also #5095
+
+  scale <- scale_x_binned(right = FALSE, show.limits = TRUE)
+  scale$train(c(14, 29))
+
+  limits <- scale$get_limits()
+  breaks <- scale$get_breaks()
+  new_limits <- scale$get_limits()
+
+  # Positive control
+  expect_equal(limits,     c(14, 29))
+  # Test case, should have been updated in break calculation
+  expect_equal(new_limits, c(14, 30))
+
+  # Negative control
+  # Now, new limits should not be updated because limits were given instead
+  # of computed
+  scale <- scale_x_binned(right = FALSE, show.limits = TRUE,
+                          limits = c(14, 29))
+  limits <- scale$get_limits()
+  breaks <- scale$get_breaks()
+  new_limits <- scale$get_limits()
+
+  expect_equal(limits, new_limits)
+})
+
+test_that("binned limits should not compute out-of-bounds breaks", {
+  scale <- scale_x_binned(n.breaks = 10)
+  scale$train(c(1, 9))
+
+  limits <- scale$get_limits()
+  breaks <- scale$get_breaks()
+  expect_length(breaks, 7) # Not the requested 10 due to oob discarding
+  expect_true(all(
+    breaks > limits[1] & breaks < limits[2]
+  ))
+})
+
 test_that('binned scales can calculate breaks on dates', {
 
   data <- seq(as.Date("2000-01-01"), as.Date("2020-01-01"), length.out = 100)

tests/testthat/_snaps/draw-key/horizontal-boxplot-and-crossbar.svg

@@ -15,3 +15,15 @@ test_that("stat_ecdf works in both directions", {
   expect_snapshot_error(ggplot_build(p))
 })
 
+# See #5113 and #5112
+test_that("stat_ecdf responds to axis transformations", {
+  n <- 4
+  answer <- c(seq(0, 1, length.out = n + 1), 1)
+  p <- ggplot(data_frame0(x = seq_len(n)), aes(x)) + stat_ecdf()
+
+  ld <- layer_data(p)
+  expect_equal(ld$y, answer)
+
+  ld <- layer_data(p + scale_y_sqrt())
+  expect_equal(ld$y, sqrt(answer))
+})