use helper

tidyverse · Aug 28, 2024 · f71d346 · f71d346
1 parent 38b0e3f
commit f71d346
Show file tree

Hide file tree

Showing 6 changed files with 52 additions and 34 deletions.
diff --git a/R/geom-bar.R b/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),

diff --git a/R/geom-boxplot.R b/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"),

diff --git a/R/geom-dotplot.R b/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") {

diff --git a/R/geom-errorbar.R b/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))

diff --git a/R/geom-tile.R b/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"),

diff --git a/R/geom-violin.R b/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"),