breaks argument in stat_contour() accepts function.

NAMESPACE

@@ -219,6 +219,7 @@ export(autolayer)
 export(autoplot)
 export(benchplot)
 export(borders)
+export(breaks_default)
 export(calc_element)
 export(combine_vars)
 export(continuous_scale)

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 = breaks_default,
+                         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, bins 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 = breaks_default,
+                         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,
       ...
     )
   )
@@ -31,26 +43,23 @@ stat_contour <- function(mapping = NULL, data = NULL,
 #' @usage NULL
 #' @export
 StatContour <- ggproto("StatContour", Stat,
-  required_aes = c("x", "y", "z"),
-  default_aes = aes(order = ..level..),
+                       required_aes = c("x", "y", "z"),
+                       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
-    if (is.null(breaks)) {
-      breaks <- fullseq(range(data$z), binwidth)
-    }
+                       compute_group = function(data, scales, bins = NULL, binwidth = NULL,
+                                                breaks = breaks_default,
+                                                complete = FALSE, na.rm = FALSE) {
+                         # Check is.null(breaks) for backwards compatibility
+                         if (is.null(breaks)) {
+                           breaks <- breaks_default
+                         }
+                         if (is.function(breaks)) {
+                           breaks <- breaks(range(data$z), bins = bins,
+                                            binwidth = binwidth)
+                         }
 
-    contour_lines(data, breaks, complete = complete)
-  }
+                         contour_lines(data, breaks, complete = complete)
+                       }
 
 )
 
@@ -68,7 +77,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(
@@ -116,3 +125,27 @@ poly_dir <- function(x, y) {
 #   geom_path(aes(group = piece, colour = factor(dir)))
 # last_plot() + facet_wrap(~ level)
 
+#' Default breaks
+#'
+#' Default behaviour for computing breaks in [stat_contour()].
+#'
+#' @param range The range of the data
+#' @param bins Number of evenly spaced breaks.
+#' @param binwidth Distance between breaks.
+#'
+#' @export
+breaks_default <- function(range, bins, binwidth) {
+  # If no parameters set, use pretty bins
+  if (is.null(bins) && is.null(binwidth)) {
+    breaks <- pretty(range, 10)
+  }
+  # If provided, use bins to calculate binwidth
+  if (!is.null(bins)) {
+    binwidth <- diff(range) / bins
+  }
+  # If necessary, compute breaks from binwidth
+  if(!is.null(binwidth)) {
+    breaks <- fullseq(range, binwidth)
+  }
+  return(breaks)
+}