Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Fetching contributors…

Cannot retrieve contributors at this time

78 lines (68 sloc) 2.837 kb
#' Continuous quantiles.
#'
#' @param quantiles conditional quantiles of y to calculate and display
#' @param formula formula relating y variables to x variables
#' @param method Quantile regression method to use. Currently only supports
#' \code{\link[quantreg]{rq}}.
#' @param na.rm If \code{FALSE} (the default), removes missing values with
#' a warning. If \code{TRUE} silently removes missing values.
#' @inheritParams stat_identity
#' @return a data.frame with additional columns:
#' \item{quantile}{quantile of distribution}
#' @export
#' @examples
#' \donttest{
#' msamp <- movies[sample(nrow(movies), 1000), ]
#' m <- ggplot(msamp, aes(y=rating, x=year)) + geom_point()
#' m + stat_quantile()
#' m + stat_quantile(quantiles = 0.5)
#' m + stat_quantile(quantiles = seq(0.1, 0.9, by=0.1))
#'
#' # Doesn't work. Not sure why.
#' # m + stat_quantile(method = rqss, formula = y ~ qss(x), quantiles = 0.5)
#'
#' # Add aesthetic mappings
#' m + stat_quantile(aes(weight=votes))
#'
#' # Change scale
#' m + stat_quantile(aes(colour = ..quantile..), quantiles = seq(0.05, 0.95, by=0.05))
#' m + stat_quantile(aes(colour = ..quantile..), quantiles = seq(0.05, 0.95, by=0.05)) +
#' scale_colour_gradient2(midpoint=0.5, low="green", mid="yellow", high="green")
#'
#' # Set aesthetics to fixed value
#' m + stat_quantile(colour="red", size=2, linetype=2)
#'
#' # Use qplot instead
#' qplot(year, rating, data=movies, geom="quantile")
#' }
stat_quantile <- function (mapping = NULL, data = NULL, geom = "quantile", position = "identity",
quantiles = c(0.25, 0.5, 0.75), formula = y ~ x, method = "rq",
na.rm = FALSE, ...) {
StatQuantile$new(mapping = mapping, data = data, geom = geom,
position = position, quantiles = quantiles, formula = formula,
method = method, na.rm = na.rm, ...)
}
StatQuantile <- proto(Stat, {
objname <- "quantile"
default_geom <- function(.) GeomQuantile
default_aes <- function(.) aes()
required_aes <- c("x", "y")
icon <- function(.) GeomQuantile$icon()
calculate <- function(., data, scales, quantiles=c(0.25, 0.5, 0.75), formula=y ~ x, xseq = NULL, method="rq", na.rm = FALSE, ...) {
try_require("quantreg")
if (is.null(data$weight)) data$weight <- 1
if (is.null(xseq)) xseq <- seq(min(data$x, na.rm=TRUE), max(data$x, na.rm=TRUE), length=100)
data <- as.data.frame(data)
data <- remove_missing(data, na.rm, c("x", "y"), name = "stat_quantile")
method <- match.fun(method)
model <- method(formula, data=data, tau=quantiles, weight=weight, ...)
yhats <- stats::predict(model, data.frame(x=xseq), type="matrix")
quantile <- rep(quantiles, each=length(xseq))
data.frame(
y = as.vector(yhats),
x = xseq,
quantile = quantile,
group = paste(data$group[1], quantile, sep = "-")
)
}
})
Jump to Line
Something went wrong with that request. Please try again.