Add parameter "varwidth" to geom_boxplot

R/geom-boxplot.r

@@ -32,6 +32,10 @@
 #'    the medians differ.
 #' @param notchwidth for a notched box plot, width of the notch relative to
 #'    the body (default 0.5)
+#' @param varwidth if \code{FALSE} (default) make a standard box plot. If
+#'    \code{TRUE}, boxes are drawn with widths proportional to the
+#'    square-roots of the number of observations in the groups (possibly
+#'    weighted).
 #' @export
 #'
 #' @references McGill, R., Tukey, J. W. and Larsen, W. A. (1978) Variations of
@@ -92,13 +96,17 @@
 #' b + geom_boxplot(stat = "identity")
 #' b + geom_boxplot(stat = "identity") + coord_flip()
 #' b + geom_boxplot(aes(fill = X1), stat = "identity")
+#'
+#' # Using varwidth
+#' p + geom_boxplot(varwidth = TRUE)
+#' qplot(factor(cyl), mpg, data = mtcars, geom = "boxplot", varwidth = TRUE)
 #' }
 geom_boxplot <- function (mapping = NULL, data = NULL, stat = "boxplot", position = "dodge", 
 outlier.colour = "black", outlier.shape = 16, outlier.size = 2,
-notch = FALSE, notchwidth = .5, ...) {
+notch = FALSE, notchwidth = .5, varwidth = FALSE, ...) {
   GeomBoxplot$new(mapping = mapping, data = data, stat = stat, 
   position = position, outlier.colour = outlier.colour, outlier.shape = outlier.shape, 
-  outlier.size = outlier.size, notch = notch, notchwidth = notchwidth, ...)
+  outlier.size = outlier.size, notch = notch, notchwidth = notchwidth, varwidth = varwidth, ...)
 }
 
 GeomBoxplot <- proto(Geom, {
@@ -117,15 +125,28 @@ GeomBoxplot <- proto(Geom, {
       df$ymin_final <- pmin(out_min, df$ymin)
       df$ymax_final <- pmax(out_max, df$ymax)
     } 
-
-    transform(df,
-      xmin = x - width / 2, xmax = x + width / 2, width = NULL
-    )
+    # if varwidth not requested or not available, don't use it
+    if(is.null(params) || is.null(params$varwidth) || !params$varwidth || is.null(df$relvarwidth)) {
+        if (is.null(df$relvarwidth)) {
+          transform(df,
+            xmin = x - width / 2, xmax = x + width / 2, width = NULL
+          )
+        } else {
+          transform(df,
+            xmin = x - width / 2, xmax = x + width / 2, width = NULL, relvarwidth = NULL
+          )
+        }
+    } else {
+      df$relvarwidth <- df$relvarwidth / max(df$relvarwidth)
+      transform(df,
+        xmin = x - relvarwidth * width / 2, xmax = x + relvarwidth * width / 2, width = NULL, relvarwidth = NULL
+      )
+    }
 
   }
 
   draw <- function(., data, ..., fatten = 2, outlier.colour = NULL, outlier.shape = NULL, outlier.size = 2,
-                   notch = FALSE, notchwidth = .5) { 
+                   notch = FALSE, notchwidth = .5, varwidth = FALSE) {
     common <- data.frame(
       colour = data$colour, 
       size = data$size, 

R/stat-boxplot.r

@@ -76,7 +76,8 @@ StatBoxplot <- proto(Stat, {
 
       transform(df,
         x = if (is.factor(x)) x[1] else mean(range(x)),
-        width = width
+        width = width,
+        relvarwidth = sqrt(n)
       )
     })
   }

man/geom_boxplot.Rd

@@ -22,6 +22,11 @@ geom_boxplot(mapping = NULL, data = NULL, stat = "boxplot",
   \item{notchwidth}{for a notched box plot, width of the
   notch relative to the body (default 0.5)}
 
+  \item{varwidth}{if \code{FALSE} (default) make a standard box plot.
+  If \code{TRUE}, boxes are drawn with widths proportional to the
+  square-roots of the number of observations in the groups (possibly
+  weighted).}
+
   \item{mapping}{The aesthetic mapping, usually constructed
   with \code{\link{aes}} or \code{\link{aes_string}}. Only
   needs to be set at the layer level if you are overriding
@@ -122,6 +127,10 @@ b <- ggplot(abc, aes(x = X1, ymin = `0\%`, lower = `25\%`, middle = `50\%`, uppe
 b + geom_boxplot(stat = "identity")
 b + geom_boxplot(stat = "identity") + coord_flip()
 b + geom_boxplot(aes(fill = X1), stat = "identity")
+
+# Using varwidth
+p + geom_boxplot(varwidth = TRUE)
+qplot(factor(cyl), mpg, data = mtcars, geom = "boxplot", varwidth = TRUE)
 }
 }
 \references{