52
52
# ' are significantly different.
53
53
# ' @param notchwidth For a notched box plot, width of the notch relative to
54
54
# ' the body (defaults to `notchwidth = 0.5`).
55
+ # ' @param staplewidth The relative width of staples to the width of the box.
56
+ # ' Staples mark the ends of the whiskers with a line.
55
57
# ' @param varwidth If `FALSE` (default) make a standard box plot. If
56
58
# ' `TRUE`, boxes are drawn with widths proportional to the
57
59
# ' square-roots of the number of observations in the groups (possibly
@@ -119,6 +121,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
119
121
outlier.alpha = NULL ,
120
122
notch = FALSE ,
121
123
notchwidth = 0.5 ,
124
+ staplewidth = 0 ,
122
125
varwidth = FALSE ,
123
126
na.rm = FALSE ,
124
127
orientation = NA ,
@@ -134,6 +137,8 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
134
137
position $ preserve <- " single"
135
138
}
136
139
}
140
+
141
+ check_number_decimal(staplewidth )
137
142
check_bool(outliers )
138
143
139
144
layer(
@@ -154,6 +159,7 @@ geom_boxplot <- function(mapping = NULL, data = NULL,
154
159
outlier.alpha = outlier.alpha ,
155
160
notch = notch ,
156
161
notchwidth = notchwidth ,
162
+ staplewidth = staplewidth ,
157
163
varwidth = varwidth ,
158
164
na.rm = na.rm ,
159
165
orientation = orientation ,
@@ -218,7 +224,7 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
218
224
outlier.fill = NULL , outlier.shape = 19 ,
219
225
outlier.size = 1.5 , outlier.stroke = 0.5 ,
220
226
outlier.alpha = NULL , notch = FALSE , notchwidth = 0.5 ,
221
- varwidth = FALSE , flipped_aes = FALSE ) {
227
+ staplewidth = 0 , varwidth = FALSE , flipped_aes = FALSE ) {
222
228
data <- check_linewidth(data , snake_class(self ))
223
229
data <- flip_data(data , flipped_aes )
224
230
# this may occur when using geom_boxplot(stat = "identity")
@@ -282,8 +288,28 @@ GeomBoxplot <- ggproto("GeomBoxplot", Geom,
282
288
outliers_grob <- NULL
283
289
}
284
290
291
+ if (staplewidth != 0 ) {
292
+ staples <- data_frame0(
293
+ x = rep((data $ xmin - data $ x ) * staplewidth + data $ x , 2 ),
294
+ xend = rep((data $ xmax - data $ x ) * staplewidth + data $ x , 2 ),
295
+ y = c(data $ ymax , data $ ymin ),
296
+ yend = c(data $ ymax , data $ ymin ),
297
+ alpha = c(NA_real_ , NA_real_ ),
298
+ !!! common ,
299
+ .size = 2
300
+ )
301
+ staples <- flip_data(staples , flipped_aes )
302
+ staple_grob <- GeomSegment $ draw_panel(
303
+ staples , panel_params , coord ,
304
+ lineend = lineend
305
+ )
306
+ } else {
307
+ staple_grob <- NULL
308
+ }
309
+
285
310
ggname(" geom_boxplot" , grobTree(
286
311
outliers_grob ,
312
+ staple_grob ,
287
313
GeomSegment $ draw_panel(whiskers , panel_params , coord , lineend = lineend ),
288
314
GeomCrossbar $ draw_panel(
289
315
box ,
0 commit comments