POC: Standardise width calculation

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

@@ -176,21 +176,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
  }
@@ -331,7 +331,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

@@ -33,7 +33,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
  ),
 
@@ -47,17 +47,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

@@ -889,3 +889,32 @@
  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
+}