Fetching contributors…
Cannot retrieve contributors at this time
104 lines (99 sloc) 2.95 KB
#' Superimpose a function.
#'
#' @section Aesthetics:
#' \Sexpr[results=rd,stage=build]{ggplot2:::rd_aesthetics("stat", "function")}
#'
#' @param fun function to use
#' @param n number of points to interpolate along
#' @param args list of additional arguments to pass to \code{fun}
#' @param xlim Optionally, restrict the range of the function to this range.
#' @inheritParams layer
#' @inheritParams geom_point
#' @section Computed variables:
#' \describe{
#' \item{x}{x's along a grid}
#' \item{y}{value of function evaluated at corresponding x}
#' }
#' @export
#' @examples
#' set.seed(1492)
#' df <- data.frame(
#' x = rnorm(100)
#' )
#' x <- df$x
#' base <- ggplot(df, aes(x)) + geom_density()
#' base + stat_function(fun = dnorm, colour = "red")
#' base + stat_function(fun = dnorm, colour = "red", args = list(mean = 3))
#'
#' # Plot functions without data
#' # Examples adapted from Kohske Takahashi
#'
#' # Specify range of x-axis
#' ggplot(data.frame(x = c(0, 2)), aes(x)) +
#' stat_function(fun = exp, geom = "line")
#'
#' # Plot a normal curve
#' ggplot(data.frame(x = c(-5, 5)), aes(x)) + stat_function(fun = dnorm)
#'
#' # To specify a different mean or sd, use the args parameter to supply new values
#' ggplot(data.frame(x = c(-5, 5)), aes(x)) +
#' stat_function(fun = dnorm, args = list(mean = 2, sd = .5))
#'
#' # Two functions on the same plot
#' f <- ggplot(data.frame(x = c(0, 10)), aes(x))
#' f + stat_function(fun = sin, colour = "red") +
#' stat_function(fun = cos, colour = "blue")
#'
#' # Using a custom function
#' test <- function(x) {x ^ 2 + x + 20}
#' f + stat_function(fun = test)
stat_function <- function(mapping = NULL, data = NULL,
geom = "path", position = "identity",
...,
fun,
xlim = NULL,
n = 101,
args = list(),
na.rm = FALSE,
show.legend = NA,
inherit.aes = TRUE) {
layer(
data = data,
mapping = mapping,
stat = StatFunction,
geom = geom,
position = position,
show.legend = show.legend,
inherit.aes = inherit.aes,
params = list(
fun = fun,
n = n,
args = args,
na.rm = na.rm,
xlim = xlim,
...
)
)
}
#' @rdname ggplot2-ggproto
#' @format NULL
#' @usage NULL
#' @export
StatFunction <- ggproto("StatFunction", Stat,
default_aes = aes(y = ..y..),
compute_group = function(data, scales, fun, xlim = NULL, n = 101, args = list()) {
range <- xlim %||% scales$x$dimension()
xseq <- seq(range[1], range[2], length.out = n)
if (scales$x$is_discrete()) {
x_trans <- xseq
} else {
# For continuous scales, need to back transform from transformed range
# to original values
x_trans <- scales$x$trans$inverse(xseq)
}
data.frame(
x = xseq,
y = do.call(fun, c(list(quote(x_trans)), args))
)
}
)