breaks argument in stat_contour() accepts function.

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,
       ...
     )

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)
-