diff --git a/R/geom-contour.r b/R/geom-contour.r index 92fe17d8f5..ca99a08951 100644 --- a/R/geom-contour.r +++ b/R/geom-contour.r @@ -14,6 +14,8 @@ #' @inheritParams layer #' @inheritParams geom_point #' @inheritParams geom_path +#' @inheritParams stat_contour +#' #' @seealso [geom_density_2d()]: 2d density contours #' @export #' @export @@ -36,6 +38,13 @@ #' v + geom_contour(binwidth = 0.01) #' v + geom_contour(binwidth = 0.001) #' +#' # Passing your own function to breaks +#' my_breaks <- function(range, binwidth, bins) { +#' b <- ggplot2::breaks_default(range, binwidth, bins) +#' b[b != 0.004] +#' } +#' v + geom_contour(breaks = my_breaks) +#' #' # Other parameters #' v + geom_contour(aes(colour = ..level..)) #' v + geom_contour(colour = "red") @@ -48,6 +57,9 @@ geom_contour <- function(mapping = NULL, data = NULL, lineend = "butt", linejoin = "round", linemitre = 1, + breaks = fullseq, + bins = NULL, + binwidth = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { @@ -63,6 +75,9 @@ geom_contour <- function(mapping = NULL, data = NULL, lineend = lineend, linejoin = linejoin, linemitre = linemitre, + breaks = breaks, + bins = bins, + binwidth = binwidth, na.rm = na.rm, ... ) diff --git a/R/stat-contour.r b/R/stat-contour.r index a421973251..4d30399f36 100644 --- a/R/stat-contour.r +++ b/R/stat-contour.r @@ -1,4 +1,10 @@ #' @inheritParams stat_identity +#' @param breaks One of: +#' - A numeric vector of breaks +#' - A function that takes the range of the data and binwidth as input +#' and returns breaks as output +#' @param bins Number of evenly spaced breaks. +#' @param binwidth Distance between breaks. #' @export #' @section Computed variables: #' \describe{ @@ -8,6 +14,9 @@ stat_contour <- function(mapping = NULL, data = NULL, geom = "contour", position = "identity", ..., + breaks = fullseq, + bins = NULL, + binwidth = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) { @@ -21,6 +30,9 @@ stat_contour <- function(mapping = NULL, data = NULL, inherit.aes = inherit.aes, params = list( na.rm = na.rm, + breaks = breaks, + bins = bins, + binwidth = binwidth, ... ) ) @@ -35,23 +47,28 @@ StatContour <- ggproto("StatContour", Stat, default_aes = aes(order = ..level..), compute_group = function(data, scales, bins = NULL, binwidth = NULL, - breaks = NULL, complete = FALSE, na.rm = FALSE) { - # If no parameters set, use pretty bins - if (is.null(bins) && is.null(binwidth) && is.null(breaks)) { - breaks <- pretty(range(data$z), 10) - } - # If provided, use bins to calculate binwidth - if (!is.null(bins)) { - binwidth <- diff(range(data$z)) / bins - } - # If necessary, compute breaks from binwidth + breaks = fullseq, complete = FALSE, + na.rm = FALSE) { + # Check is.null(breaks) for backwards compatibility if (is.null(breaks)) { - breaks <- fullseq(range(data$z), binwidth) + breaks <- fullseq } - contour_lines(data, breaks, complete = complete) - } + if (is.function(breaks)) { + # If no parameters set, use pretty bins to calculate binwidth + if (is.null(bins) && is.null(binwidth)) { + binwidth <- diff(pretty(range(data$z), 10))[1] + } + # If provided, use bins to calculate binwidth + if (!is.null(bins)) { + binwidth <- diff(range(data$z)) / bins + } + breaks <- breaks(range(data$z), binwidth) + } + + contour_lines(data, breaks, complete = complete) + } ) @@ -68,7 +85,7 @@ contour_lines <- function(data, breaks, complete = FALSE) { if (is.list(z)) { stop("Contour requires single `z` at each combination of `x` and `y`.", - call. = FALSE) + call. = FALSE) } cl <- grDevices::contourLines( @@ -115,4 +132,3 @@ poly_dir <- function(x, y) { # ggplot(contours, aes(x, y)) + # geom_path(aes(group = piece, colour = factor(dir))) # last_plot() + facet_wrap(~ level) - diff --git a/man/geom_contour.Rd b/man/geom_contour.Rd index 1172f11314..d657148da2 100644 --- a/man/geom_contour.Rd +++ b/man/geom_contour.Rd @@ -7,11 +7,12 @@ \usage{ geom_contour(mapping = NULL, data = NULL, stat = "contour", position = "identity", ..., lineend = "butt", linejoin = "round", - linemitre = 1, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) + linemitre = 1, breaks = fullseq, bins = NULL, binwidth = NULL, + na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) stat_contour(mapping = NULL, data = NULL, geom = "contour", - position = "identity", ..., na.rm = FALSE, show.legend = NA, - inherit.aes = TRUE) + position = "identity", ..., breaks = fullseq, bins = NULL, + binwidth = NULL, na.rm = FALSE, show.legend = NA, inherit.aes = TRUE) } \arguments{ \item{mapping}{Set of aesthetic mappings created by \code{\link[=aes]{aes()}} or @@ -50,6 +51,17 @@ to the paired geom/stat.} \item{linemitre}{Line mitre limit (number greater than 1)} +\item{breaks}{One of: +\itemize{ +\item A numeric vector of breaks +\item A function that takes the range of the data and binwidth as input +and returns breaks as output +}} + +\item{bins}{Number of evenly spaced breaks.} + +\item{binwidth}{Distance between breaks.} + \item{na.rm}{If \code{FALSE}, the default, missing values are removed with a warning. If \code{TRUE}, missing values are silently removed.} @@ -106,6 +118,13 @@ v + geom_contour(bins = 10) v + geom_contour(binwidth = 0.01) v + geom_contour(binwidth = 0.001) +# Passing your own function to breaks +my_breaks <- function(range, binwidth, bins) { + b <- ggplot2::breaks_default(range, binwidth, bins) + b[b != 0.004] +} +v + geom_contour(breaks = my_breaks) + # Other parameters v + geom_contour(aes(colour = ..level..)) v + geom_contour(colour = "red")