32
32
# ' the medians differ.
33
33
# ' @param notchwidth for a notched box plot, width of the notch relative to
34
34
# ' the body (default 0.5)
35
+ # ' @param varwidth if \code{FALSE} (default) make a standard box plot. If
36
+ # ' \code{TRUE}, boxes are drawn with widths proportional to the
37
+ # ' square-roots of the number of observations in the groups (possibly
38
+ # ' weighted).
35
39
# ' @export
36
40
# '
37
41
# ' @references McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of
92
96
# ' b + geom_boxplot(stat = "identity")
93
97
# ' b + geom_boxplot(stat = "identity") + coord_flip()
94
98
# ' b + geom_boxplot(aes(fill = X1), stat = "identity")
99
+ # '
100
+ # ' # Using varwidth
101
+ # ' p + geom_boxplot(varwidth = TRUE)
102
+ # ' qplot(factor(cyl), mpg, data = mtcars, geom = "boxplot", varwidth = TRUE)
95
103
# ' }
96
104
geom_boxplot <- function (mapping = NULL , data = NULL , stat = " boxplot" , position = " dodge" ,
97
105
outlier.colour = " black" , outlier.shape = 16 , outlier.size = 2 ,
98
- notch = FALSE , notchwidth = .5 , ... ) {
106
+ notch = FALSE , notchwidth = .5 , varwidth = FALSE , ... ) {
99
107
GeomBoxplot $ new(mapping = mapping , data = data , stat = stat ,
100
108
position = position , outlier.colour = outlier.colour , outlier.shape = outlier.shape ,
101
- outlier.size = outlier.size , notch = notch , notchwidth = notchwidth , ... )
109
+ outlier.size = outlier.size , notch = notch , notchwidth = notchwidth , varwidth = varwidth , ... )
102
110
}
103
111
104
112
GeomBoxplot <- proto(Geom , {
@@ -118,14 +126,27 @@ GeomBoxplot <- proto(Geom, {
118
126
df $ ymax_final <- pmax(out_max , df $ ymax )
119
127
}
120
128
121
- transform(df ,
122
- xmin = x - width / 2 , xmax = x + width / 2 , width = NULL
123
- )
129
+ # if varwidth not requested or not available, don't use it
130
+ if (is.null(params ) || is.null(params $ varwidth ) || ! params $ varwidth || is.null(df $ relvarwidth )) {
131
+ if (is.null(df $ relvarwidth )) {
132
+ transform(df ,
133
+ xmin = x - width / 2 , xmax = x + width / 2 , width = NULL
134
+ )
135
+ } else {
136
+ transform(df ,
137
+ xmin = x - width / 2 , xmax = x + width / 2 , width = NULL , relvarwidth = NULL
138
+ )
139
+ }
140
+ } else {
141
+ transform(df ,
142
+ xmin = x - relvarwidth * width / 2 , xmax = x + relvarwidth * width / 2 , width = NULL , relvarwidth = NULL
143
+ )
144
+ }
124
145
125
146
}
126
147
127
148
draw <- function (. , data , ... , fatten = 2 , outlier.colour = NULL , outlier.shape = NULL , outlier.size = 2 ,
128
- notch = FALSE , notchwidth = .5 ) {
149
+ notch = FALSE , notchwidth = .5 , varwidth = FALSE ) {
129
150
common <- data.frame (
130
151
colour = data $ colour ,
131
152
size = data $ size ,
0 commit comments