Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 64 lines (58 sloc) 2.386 kb
c6918f6 @jrnold refactoring
authored
1 ##' Calculate components of a five-number summary
2 ##'
3 ##' The five number summary of a sample is the minimum, first quartile,
4 ##' median, third quartile, and maximum.
5 ##'
6 ##' @section Aesthetics:
74de502 @jrnold fix #3: renamed package from ggplotJrnold to ggthemes
authored
7 ##' \Sexpr[results=rd,stage=build]{ggthemes:::rd_aesthetics("stat_fivenumber", ggthemes:::StatFivenumber)}
c6918f6 @jrnold refactoring
authored
8 ##'
9 ##' @param na.rm If \code{FALSE} (the default), removes missing values with
10 ##' a warning. If \code{TRUE} silently removes missing values.
24db54d @jrnold fixing bugs to pass R CMD check
authored
11 ##' @inheritParams ggplot2::stat_identity
c6918f6 @jrnold refactoring
authored
12 ##' @return A data frame with additional columns:
13 ##' \item{width}{width of boxplot}
14 ##' \item{ymin}{minimum}
15 ##' \item{lower}{lower hinge, 25\% quantile}
16 ##' \item{notchlower}{lower edge of notch = median - 1.58 * IQR / sqrt(n)}
17 ##' \item{middle}{median, 50\% quantile}
18 ##' \item{notchupper}{upper edge of notch = median + 1.58 * IQR / sqrt(n)}
19 ##' \item{upper}{upper hinge, 75\% quantile}
20 ##' \item{ymax}{maximum}
21 ##' @seealso \code{\link{stat_boxplot}}
22 ##' @export
23 stat_fivenumber <- function (mapping = NULL, data = NULL,
24 geom = "boxplot", position = "dodge",
25 na.rm = FALSE, ...) {
26 StatFivenumber$new(mapping = mapping, data = data, geom = geom,
27 position = position, na.rm = na.rm, ...)
28 }
29
30 StatFivenumber <- proto(ggplot2:::Stat, {
31 objname <- "fivenumber"
32
33 required_aes <- c("x", "y")
34 default_geom <- function(.) GeomBoxplot
35
36 calculate_groups <- function(., data, na.rm = FALSE, width = NULL, ...) {
d8aadd0 @jrnold edit typo
authored
37 data <- remove_missing(data, na.rm, c("y", "weight"), name="stat_fivenumber",
c6918f6 @jrnold refactoring
authored
38 finite = TRUE)
39 data$weight <- data$weight %||% 1
40 width <- width %||% resolution(data$x) * 0.75
41
42 .super$calculate_groups(., data, na.rm = na.rm, width = width, ...)
43 }
44
45 calculate <- function(., data, scales, width=NULL, na.rm = FALSE, ...) {
46 with(data, {
47 qs <- c(0, 0.25, 0.5, 0.75, 1)
48 if (length(unique(weight)) != 1) {
49 try_require("quantreg")
50 stats <- as.numeric(coef(rq(y ~ 1, weights = weight, tau=qs)))
51 } else {
52 stats <- as.numeric(quantile(y, qs))
53 }
54 names(stats) <- c("ymin", "lower", "middle", "upper", "ymax")
55 if (length(unique(x)) > 1) width <- diff(range(x)) * 0.9
56 df <- as.data.frame(as.list(stats))
57 transform(df,
58 x = if (is.factor(x)) x[1] else mean(range(x)),
59 width = width
60 )
61 })
62 }
63 })
Something went wrong with that request. Please try again.