Standardise width calculation (#6065)

* helper for computing size

* use helper

* add news bullet

Author: teunbrand

NEWS.md

@@ -252,6 +252,8 @@
 * `geom_abline()` clips to the panel range in the vertical direction too
   (@teunbrand, #6086).
 * Added `panel.widths` and `panel.heights` to `theme()` (#5338, @teunbrand).
+* Standardised the calculation of `width`, which are now implemented as
+  aesthetics (@teunbrand, #2800).
 
 # ggplot2 3.5.1
 

R/geom-bar.R

@@ -130,7 +130,7 @@ GeomBar <- ggproto("GeomBar", GeomRect,
   # limits, not just those for which x and y are outside the limits
   non_missing_aes = c("xmin", "xmax", "ymin", "ymax"),
 
-  default_aes = aes(!!!GeomRect$default_aes, width = NULL),
+  default_aes = aes(!!!GeomRect$default_aes, width = 0.9),
 
   setup_params = function(data, params) {
     params$flipped_aes <- has_flipped_aes(data, params)
@@ -139,14 +139,13 @@ GeomBar <- ggproto("GeomBar", GeomRect,
 
   extra_params = c("just", "na.rm", "orientation"),
 
-  setup_data = function(data, params) {
+  setup_data = function(self, data, params) {
     data$flipped_aes <- params$flipped_aes
     data <- flip_data(data, params$flipped_aes)
-    data$width <- data$width %||%
-      params$width %||% (min(vapply(
-        split(data$x, data$PANEL, drop = TRUE),
-        resolution, numeric(1), zero = FALSE
-      )) * 0.9)
+    data <- compute_data_size(
+      data, size = params$width,
+      default = self$default_aes$width, zero = FALSE
+    )
     data$just <- params$just %||% 0.5
     data <- transform(data,
       ymin = pmin(y, 0), ymax = pmax(y, 0),

R/geom-boxplot.R

@@ -236,21 +236,21 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
 #' @export
 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", "outliers"),
+  extra_params = c("na.rm", "orientation", "outliers"),
 
   setup_params = function(data, params) {
     params$flipped_aes <- has_flipped_aes(data, params)
     params
   },
 
-  setup_data = function(data, params) {
+  setup_data = function(self, data, params) {
     data$flipped_aes <- params$flipped_aes
     data <- flip_data(data, params$flipped_aes)
-    data$width <- data$width %||%
-      params$width %||% (resolution(data$x, FALSE, TRUE) * 0.9)
-
+    data <- compute_data_size(
+      data, params$width,
+      default = self$default_aes$width,
+      zero = FALSE, discrete = TRUE
+    )
     if (isFALSE(params$outliers)) {
       data$outliers <- NULL
     }
@@ -389,7 +389,8 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
     weight = 1, colour = from_theme(col_mix(ink, paper, 0.2)),
     fill = from_theme(paper), size = from_theme(pointsize),
     alpha = NA, shape = from_theme(pointshape), linetype = from_theme(bordertype),
-    linewidth = from_theme(borderwidth)
+    linewidth = from_theme(borderwidth),
+    width = 0.9
   ),
 
   required_aes = c("x|y", "lower|xlower", "upper|xupper", "middle|xmiddle", "ymin|xmin", "ymax|xmax"),

R/geom-dotplot.R

@@ -194,12 +194,16 @@ GeomDotplot <- ggproto("GeomDotplot", Geom,
     alpha = NA,
     stroke = from_theme(borderwidth * 2),
     linetype = from_theme(linetype),
-    weight = 1
+    weight = 1,
+    width = 0.9
   ),
 
-  setup_data = function(data, params) {
-    data$width <- data$width %||%
-      params$width %||% (resolution(data$x, FALSE, TRUE) * 0.9)
+  setup_data = function(self, data, params) {
+    data <- compute_data_size(
+      data, params$width,
+      default = self$default_aes$width,
+      zero = FALSE, discrete = TRUE
+    )
 
     # Set up the stacking function and range
     if (is.null(params$stackdir) || params$stackdir == "up") {

R/geom-errorbar.R

@@ -62,7 +62,7 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
     colour = from_theme(ink),
     linewidth = from_theme(linewidth),
     linetype = from_theme(linetype),
-    width = 0.5,
+    width = 0.9,
     alpha = NA
   ),
 
@@ -76,17 +76,21 @@ GeomErrorbar <- ggproto("GeomErrorbar", Geom,
 
   extra_params = c("na.rm", "orientation"),
 
-  setup_data = function(data, params) {
+  setup_data = function(self, data, params) {
     data$flipped_aes <- params$flipped_aes
     data <- flip_data(data, params$flipped_aes)
-    data$width <- data$width %||%
-      params$width %||% (resolution(data$x, FALSE, TRUE) * 0.9)
+    data <- compute_data_size(
+      data, params$width,
+      default = self$default_aes$width,
+      zero = FALSE, discrete = TRUE
+    )
     data <- transform(data,
       xmin = x - width / 2, xmax = x + width / 2, width = NULL
     )
     flip_data(data, params$flipped_aes)
   },
 
+  # Note: `width` is vestigial
   draw_panel = function(self, data, panel_params, coord, lineend = "butt",
                         width = NULL, flipped_aes = FALSE) {
     data <- check_linewidth(data, snake_class(self))

R/geom-tile.R

@@ -109,13 +109,20 @@ geom_tile <- function(mapping = NULL, data = NULL,
 GeomTile <- ggproto("GeomTile", GeomRect,
   extra_params = c("na.rm"),
 
-  setup_data = function(data, params) {
-
-    data$width <- data$width %||% params$width %||%
-      stats::ave(data$x, data$PANEL, FUN = function(x) resolution(x, FALSE, TRUE))
-    data$height <- data$height %||% params$height %||%
-      stats::ave(data$y, data$PANEL, FUN = function(y) resolution(y, FALSE, TRUE))
+  setup_data = function(self, data, params) {
 
+    data <- compute_data_size(
+      data, params$width,
+      default = self$default_aes$width,
+      panels = "by", target = "width",
+      zero = FALSE, discrete = TRUE
+    )
+    data <- compute_data_size(
+      data, params$height,
+      default = self$default_aes$height,
+      panels = "by", target = "height",
+      zero = FALSE, discrete = TRUE
+    )
     transform(data,
       xmin = x - width / 2,  xmax = x + width / 2,  width = NULL,
       ymin = y - height / 2, ymax = y + height / 2, height = NULL
@@ -127,7 +134,7 @@ GeomTile <- ggproto("GeomTile", GeomRect,
     colour = NA,
     linewidth = from_theme(0.4 * borderwidth),
     linetype = from_theme(bordertype),
-    alpha = NA, width = NA, height = NA
+    alpha = NA, width = 1, height = 1
   ),
 
   required_aes = c("x", "y"),

R/geom-violin.R

@@ -131,11 +131,13 @@ GeomViolin <- ggproto("GeomViolin", Geom,
 
   extra_params = c("na.rm", "orientation", "lineend", "linejoin", "linemitre"),
 
-  setup_data = function(data, params) {
+  setup_data = function(self, data, params) {
     data$flipped_aes <- params$flipped_aes
     data <- flip_data(data, params$flipped_aes)
-    data$width <- data$width %||%
-      params$width %||% (resolution(data$x, FALSE, TRUE) * 0.9)
+    data <- compute_data_size(
+      data, params$width,
+      default = self$default_aes$width
+    )
     # ymin, ymax, xmin, and xmax define the bounding rectangle for each group
     data <- dapply(data, "group", transform,
       xmin = x - width / 2,
@@ -203,7 +205,8 @@ GeomViolin <- ggproto("GeomViolin", Geom,
     fill = from_theme(paper),
     linewidth = from_theme(borderwidth),
     linetype = from_theme(bordertype),
-    alpha = NA
+    alpha = NA,
+    width = 0.9
   ),
 
   required_aes = c("x", "y"),

R/utilities.R

@@ -909,3 +909,32 @@ prompt_install <- function(pkg, reason = NULL) {
   utils::install.packages(pkg)
   is_installed(pkg)
 }
+
+compute_data_size <- function(data, size, default = 0.9,
+                              target = "width",
+                              panels = c("across", "by", "ignore"),
+                              ...) {
+
+  data[[target]] <- data[[target]] %||% size
+  if (!is.null(data[[target]])) {
+    return(data)
+  }
+
+  var <- if (target == "height") "y" else "x"
+  panels <- arg_match0(panels, c("across", "by", "ignore"))
+
+  if (panels == "across") {
+    res <- split(data[[var]], data$PANEL, drop = FALSE)
+    res <- vapply(res, resolution, FUN.VALUE = numeric(1), ...)
+    res <- min(res, na.rm = TRUE)
+  } else if (panels == "by") {
+    res <- ave(data[[var]], data$PANEL, FUN = function(x) resolution(x, ...))
+  } else {
+    res <- resolution(data[[var]], ...)
+  }
+  if (is_quosure(default)) {
+    default <- eval_tidy(default, data = data)
+  }
+  data[[target]] <- res * (default %||% 0.9)
+  data
+}