Skip to content

Commit f220ded

Browse files
teunbrandteunbrand
authored
Extra boxplot features (#5423)
* expand default aes * crossbar can use boxplot's median line settings * insert new aesthetics * adapt key drawing * update snapshots * fix legend linewidth * document * capture outlier settings in list * Use fixed parameters instead of aesthetics * Adjust key drawing * Add test * Document * document box arguments * add `middle_gp` and `box_gp` to `geom_crossbar()` * adapt legend keys * redocument * fix news bullet * skip failing test
1 parent e594b49 commit f220ded

12 files changed

+437
-60
lines changed

‎NEWS.md

Lines changed: 2 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -1,5 +1,7 @@
11
# ggplot2 (development version)
22

3+
* `geom_boxplot()` gains additional arguments to style the colour, linetype and
4+
linewidths of the box, whiskers, median line and staples (@teunbrand, #5126)
35
* (internal) Using `after_scale()` in the `Geom*$default_aes()` field is now
46
evaluated in the context of data (@teunbrand, #6135)
57
* Fixed bug where binned scales wouldn't simultaneously accept transformations

‎R/geom-boxplot.R

Lines changed: 98 additions & 40 deletions
Original file line numberDiff line numberDiff line change
@@ -43,11 +43,20 @@
4343
#' needs to show the full data range, please use `outlier.shape = NA` instead.
4444
#' @param outlier.colour,outlier.color,outlier.fill,outlier.shape,outlier.size,outlier.stroke,outlier.alpha
4545
#' Default aesthetics for outliers. Set to `NULL` to inherit from the
46-
#' aesthetics used for the box.
47-
#'
48-
#' In the unlikely event you specify both US and UK spellings of colour, the
49-
#' US spelling will take precedence.
50-
#'
46+
#' data's aesthetics.
47+
#' @param whisker.colour,whisker.color,whisker.linetype,whisker.linewidth
48+
#' Default aesthetics for the whiskers. Set to `NULL` to inherit from the
49+
#' data's aesthetics.
50+
#' @param median.colour,median.color,median.linetype,median.linewidth
51+
#' Default aesthetics for the median line. Set to `NULL` to inherit from the
52+
#' data's aesthetics.
53+
#' @param staple.colour,staple.color,staple.linetype,staple.linewidth
54+
#' Default aesthetics for the staples. Set to `NULL` to inherit from the
55+
#' data's aesthetics. Note that staples don't appear unless the `staplewidth`
56+
#' argument is set to a non-zero size.
57+
#' @param box.colour,box.color,box.linetype,box.linewidth
58+
#' Default aesthetics for the boxes. Set to `NULL` to inherit from the
59+
#' data's aesthetics.
5160
#' @param notch If `FALSE` (default) make a standard box plot. If
5261
#' `TRUE`, make a notched box plot. Notches are used to compare groups;
5362
#' if the notches of two boxes do not overlap, this suggests that the medians
@@ -60,6 +69,9 @@
6069
#' `TRUE`, boxes are drawn with widths proportional to the
6170
#' square-roots of the number of observations in the groups (possibly
6271
#' weighted, using the `weight` aesthetic).
72+
#' @note In the unlikely event you specify both US and UK spellings of colour,
73+
#' the US spelling will take precedence.
74+
#'
6375
#' @export
6476
#' @references McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of
6577
#' box plots. The American Statistician 32, 12-16.
@@ -121,6 +133,22 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
121133
outlier.size = NULL,
122134
outlier.stroke = 0.5,
123135
outlier.alpha = NULL,
136+
whisker.colour = NULL,
137+
whisker.color = NULL,
138+
whisker.linetype = NULL,
139+
whisker.linewidth = NULL,
140+
staple.colour = NULL,
141+
staple.color = NULL,
142+
staple.linetype = NULL,
143+
staple.linewidth = NULL,
144+
median.colour = NULL,
145+
median.color = NULL,
146+
median.linetype = NULL,
147+
median.linewidth = NULL,
148+
box.colour = NULL,
149+
box.color = NULL,
150+
box.linetype = NULL,
151+
box.linewidth = NULL,
124152
notch = FALSE,
125153
notchwidth = 0.5,
126154
staplewidth = 0,
@@ -140,6 +168,39 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
140168
}
141169
}
142170

171+
outlier_gp <- list(
172+
colour = outlier.color %||% outlier.colour,
173+
fill = outlier.fill,
174+
shape = outlier.shape,
175+
size = outlier.size,
176+
stroke = outlier.stroke,
177+
alpha = outlier.alpha
178+
)
179+
180+
whisker_gp <- list(
181+
colour = whisker.color %||% whisker.colour,
182+
linetype = whisker.linetype,
183+
linewidth = whisker.linewidth
184+
)
185+
186+
staple_gp <- list(
187+
colour = staple.color %||% staple.colour,
188+
linetype = staple.linetype,
189+
linewidth = staple.linewidth
190+
)
191+
192+
median_gp <- list(
193+
colour = median.color %||% median.colour,
194+
linetype = median.linetype,
195+
linewidth = median.linewidth
196+
)
197+
198+
box_gp <- list(
199+
colour = box.color %||% box.colour,
200+
linetype = box.linetype,
201+
linewidth = box.linewidth
202+
)
203+
143204
check_number_decimal(staplewidth)
144205
check_bool(outliers)
145206

@@ -153,12 +214,11 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
153214
inherit.aes = inherit.aes,
154215
params = list2(
155216
outliers = outliers,
156-
outlier.colour = outlier.color %||% outlier.colour,
157-
outlier.fill = outlier.fill,
158-
outlier.shape = outlier.shape,
159-
outlier.size = outlier.size,
160-
outlier.stroke = outlier.stroke,
161-
outlier.alpha = outlier.alpha,
217+
outlier_gp = outlier_gp,
218+
whisker_gp = whisker_gp,
219+
staple_gp = staple_gp,
220+
median_gp = median_gp,
221+
box_gp = box_gp,
162222
notch = notch,
163223
notchwidth = notchwidth,
164224
staplewidth = staplewidth,
@@ -222,10 +282,9 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
222282
},
223283

224284
draw_group = function(self, data, panel_params, coord, lineend = "butt",
225-
linejoin = "mitre", fatten = 2, outlier.colour = NULL,
226-
outlier.fill = NULL, outlier.shape = NULL,
227-
outlier.size = NULL, outlier.stroke = 0.5,
228-
outlier.alpha = NULL, notch = FALSE, notchwidth = 0.5,
285+
linejoin = "mitre", fatten = 2, outlier_gp = NULL,
286+
whisker_gp = NULL, staple_gp = NULL, median_gp = NULL,
287+
box_gp = NULL, notch = FALSE, notchwidth = 0.5,
229288
staplewidth = 0, varwidth = FALSE, flipped_aes = FALSE) {
230289
data <- check_linewidth(data, snake_class(self))
231290
data <- flip_data(data, flipped_aes)
@@ -237,50 +296,44 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
237296
))
238297
}
239298

240-
common <- list(
241-
colour = data$colour,
242-
linewidth = data$linewidth,
243-
linetype = data$linetype,
244-
fill = fill_alpha(data$fill, data$alpha),
245-
group = data$group
246-
)
299+
common <- list(fill = fill_alpha(data$fill, data$alpha), group = data$group)
247300

248301
whiskers <- data_frame0(
249302
x = c(data$x, data$x),
250303
xend = c(data$x, data$x),
251304
y = c(data$upper, data$lower),
252305
yend = c(data$ymax, data$ymin),
306+
colour = rep(whisker_gp$colour %||% data$colour, 2),
307+
linetype = rep(whisker_gp$linetype %||% data$linetype, 2),
308+
linewidth = rep(whisker_gp$linewidth %||% data$linewidth, 2),
253309
alpha = c(NA_real_, NA_real_),
254310
!!!common,
255311
.size = 2
256312
)
257313
whiskers <- flip_data(whiskers, flipped_aes)
258314

259-
box <- data_frame0(
260-
xmin = data$xmin,
261-
xmax = data$xmax,
262-
ymin = data$lower,
263-
y = data$middle,
264-
ymax = data$upper,
265-
ynotchlower = ifelse(notch, data$notchlower, NA),
266-
ynotchupper = ifelse(notch, data$notchupper, NA),
267-
notchwidth = notchwidth,
268-
alpha = data$alpha,
269-
!!!common
315+
box <- transform(
316+
data,
317+
y = middle,
318+
ymax = upper,
319+
ymin = lower,
320+
ynotchlower = ifelse(notch, notchlower, NA),
321+
ynotchupper = ifelse(notch, notchupper, NA),
322+
notchwidth = notchwidth
270323
)
271324
box <- flip_data(box, flipped_aes)
272325

273326
if (!is.null(data$outliers) && length(data$outliers[[1]]) >= 1) {
274327
outliers <- data_frame0(
275328
y = data$outliers[[1]],
276329
x = data$x[1],
277-
colour = outlier.colour %||% data$colour[1],
278-
fill = outlier.fill %||% data$fill[1],
279-
shape = outlier.shape %||% data$shape[1],
280-
size = outlier.size %||% data$size[1],
281-
stroke = outlier.stroke %||% data$stroke[1],
330+
colour = outlier_gp$colour %||% data$colour[1],
331+
fill = outlier_gp$fill %||% data$fill[1],
332+
shape = outlier_gp$shape %||% data$shape[1] %||% 19,
333+
size = outlier_gp$size %||% data$size[1] %||% 1.5,
334+
stroke = outlier_gp$stroke %||% data$stroke[1] %||% 0.5,
282335
fill = NA,
283-
alpha = outlier.alpha %||% data$alpha[1],
336+
alpha = outlier_gp$alpha %||% data$alpha[1],
284337
.size = length(data$outliers[[1]])
285338
)
286339
outliers <- flip_data(outliers, flipped_aes)
@@ -296,6 +349,9 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
296349
xend = rep((data$xmax - data$x) * staplewidth + data$x, 2),
297350
y = c(data$ymax, data$ymin),
298351
yend = c(data$ymax, data$ymin),
352+
linetype = rep(staple_gp$linetype %||% data$linetype, 2),
353+
linewidth = rep(staple_gp$linewidth %||% data$linewidth, 2),
354+
colour = rep(staple_gp$colour %||% data$colour, 2),
299355
alpha = c(NA_real_, NA_real_),
300356
!!!common,
301357
.size = 2
@@ -320,7 +376,9 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
320376
coord,
321377
lineend = lineend,
322378
linejoin = linejoin,
323-
flipped_aes = flipped_aes
379+
flipped_aes = flipped_aes,
380+
middle_gp = median_gp,
381+
box_gp = box_gp
324382
)
325383
))
326384
},

‎R/geom-crossbar.R

Lines changed: 37 additions & 5 deletions
Original file line numberDiff line numberDiff line change
@@ -1,13 +1,40 @@
11
#' @export
22
#' @rdname geom_linerange
3+
#' @param middle.colour,middle.color,middle.linetype,middle.linewidth
4+
#' Default aesthetics for the middle line. Set to `NULL` to inherit from the
5+
#' data's aesthetics.
6+
#' @param box.colour,box.color,box.linetype,box.linewidth
7+
#' Default aesthetics for the boxes. Set to `NULL` to inherit from the
8+
#' data's aesthetics.
39
geom_crossbar <- function(mapping = NULL, data = NULL,
410
stat = "identity", position = "identity",
511
...,
12+
middle.colour = NULL,
13+
middle.color = NULL,
14+
middle.linetype = NULL,
15+
middle.linewidth = NULL,
16+
box.colour = NULL,
17+
box.color = NULL,
18+
box.linetype = NULL,
19+
box.linewidth = NULL,
620
fatten = 2.5,
721
na.rm = FALSE,
822
orientation = NA,
923
show.legend = NA,
1024
inherit.aes = TRUE) {
25+
26+
middle_gp <- list(
27+
colour = middle.color %||% middle.colour,
28+
linetype = middle.linetype,
29+
linewidth = middle.linewidth
30+
)
31+
32+
box_gp <- list(
33+
colour = box.color %||% box.colour,
34+
linetype = box.linetype,
35+
linewidth = box.linewidth
36+
)
37+
1138
layer(
1239
data = data,
1340
mapping = mapping,
@@ -17,6 +44,8 @@ geom_crossbar <- function(mapping = NULL, data = NULL,
1744
show.legend = show.legend,
1845
inherit.aes = inherit.aes,
1946
params = list2(
47+
middle_gp = middle_gp,
48+
box_gp = box_gp,
2049
fatten = fatten,
2150
na.rm = na.rm,
2251
orientation = orientation,
@@ -54,11 +83,13 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
5483

5584
draw_panel = function(self, data, panel_params, coord, lineend = "butt",
5685
linejoin = "mitre", fatten = 2.5, width = NULL,
57-
flipped_aes = FALSE) {
86+
flipped_aes = FALSE, middle_gp = NULL, box_gp = NULL) {
87+
5888
data <- check_linewidth(data, snake_class(self))
5989
data <- flip_data(data, flipped_aes)
6090

6191
middle <- transform(data, x = xmin, xend = xmax, yend = y, linewidth = linewidth * fatten, alpha = NA)
92+
middle <- data_frame0(!!!defaults(compact(middle_gp), middle))
6293

6394
has_notch <- !is.null(data$ynotchlower) && !is.null(data$ynotchupper) &&
6495
!is.na(data$ynotchlower) && !is.na(data$ynotchupper)
@@ -87,9 +118,9 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
87118
data$ymax
88119
),
89120
alpha = rep(data$alpha, 11),
90-
colour = rep(data$colour, 11),
121+
colour = rep(data$colour, 11),
91122
linewidth = rep(data$linewidth, 11),
92-
linetype = rep(data$linetype, 11),
123+
linetype = rep(data$linetype, 11),
93124
fill = rep(data$fill, 11),
94125
group = rep(seq_len(nrow(data)), 11)
95126
)
@@ -99,13 +130,14 @@ GeomCrossbar <- ggproto("GeomCrossbar", Geom,
99130
x = c(data$xmin, data$xmin, data$xmax, data$xmax, data$xmin),
100131
y = c(data$ymax, data$ymin, data$ymin, data$ymax, data$ymax),
101132
alpha = rep(data$alpha, 5),
102-
colour = rep(data$colour, 5),
133+
colour = rep(data$colour, 5),
103134
linewidth = rep(data$linewidth, 5),
104-
linetype = rep(data$linetype, 5),
135+
linetype = rep(data$linetype, 5),
105136
fill = rep(data$fill, 5),
106137
group = rep(seq_len(nrow(data)), 5) # each bar forms it's own group
107138
)
108139
}
140+
box <- data_frame0(!!!defaults(compact(box_gp), box))
109141
box <- flip_data(box, flipped_aes)
110142
middle <- flip_data(middle, flipped_aes)
111143

0 commit comments

Comments
 (0)