POC bin breaks derived from scale breaks

DESCRIPTION

@@ -109,6 +109,7 @@ Collate:
     'backports.R'
     'bench.R'
     'bin.R'
+    'breaks_cached.R'
     'coord-.R'
     'coord-cartesian-.R'
     'coord-fixed.R'

NAMESPACE

@@ -22,6 +22,7 @@ S3method(element_grob,element_blank)
 S3method(element_grob,element_line)
 S3method(element_grob,element_rect)
 S3method(element_grob,element_text)
+S3method(format,ggplot2_cached_breaks)
 S3method(format,ggproto)
 S3method(format,ggproto_method)
 S3method(fortify,"NULL")
@@ -106,6 +107,7 @@ S3method(predictdf,loess)
 S3method(print,element)
 S3method(print,ggplot)
 S3method(print,ggplot2_bins)
+S3method(print,ggplot2_cached_breaks)
 S3method(print,ggproto)
 S3method(print,ggproto_method)
 S3method(print,rel)
@@ -298,6 +300,7 @@ export(autoplot)
 export(benchplot)
 export(binned_scale)
 export(borders)
+export(breaks_cached)
 export(calc_element)
 export(check_device)
 export(combine_vars)

R/breaks_cached.R

@@ -0,0 +1,67 @@
+#' Cache scale breaks
+#'
+#' This helper caches the output of another breaks function the first time it is
+#' evaluated. All subsequent calls will return the same breaks vector
+#' regardless of the provided limits. In general this is not what you want
+#' since the breaks should change when the limits change. It is helpful in the
+#' specific case that you are using `follow.scale` on [stat_bin()] and related
+#' binning stats, because it ensures that the breaks are not recomputed after
+#' they are used to define the bin edges.
+#'
+#' @export
+#' @param breaks A function that takes the limits as input and returns breaks
+#'   as output. See [continuous_scale()] for details.
+#'
+#' @return A wrapped breaks function suitable for use with ggplot scales.
+#' @examples
+#' discoveries_df <- data.frame(
+#'   year = unlist(mapply(rep, time(discoveries), discoveries))
+#' )
+#' p <- ggplot(discoveries_df, aes(year)) +
+#'  geom_histogram(follow.scale = "minor")
+#'
+#' # Using follow.scale with function breaks can cause misalignment as the scale
+#' # can update the breaks after the bin edges are fixed by the stat
+#' p + scale_x_continuous(breaks = scales::breaks_extended())
+#'
+#' # Wrapping the same breaks function avoids this issue but can leave you with
+#' # sub-optimal breaks since they are no longer updated after stats
+#' p + scale_x_continuous(breaks = breaks_cached(scales::breaks_extended()))
+breaks_cached <- function(breaks) {
+  if (! rlang::is_function(breaks)) {
+    cli::cli_abort("{.arg breaks} must be a function")
+  }
+
+  cached <- ggplot2::ggproto(
+    "BreaksCached", NULL,
+    fn = breaks,
+    cached = NULL,
+    get_breaks = function(self, limits) {
+      if (is.null(self$cached)) self$cached <- self$fn(limits)
+      self$cached
+    }
+  )$get_breaks
+
+  class(cached) <- c("ggplot2_cached_breaks", class(cached))
+  cached
+}
+
+#' @export
+format.ggplot2_cached_breaks <- function(x, ...) {
+  bc <- environment(x)$self
+  inner <- environment(bc$fn)$f
+
+  paste0(
+    "<cached breaks function>\n",
+    ifelse(
+      is.null(bc$cached),
+      paste0("  ", format(inner), collapse = "\n"),
+      paste0("  [", class(bc$cached), "] ", paste0(format(bc$cached), collapse = " "))
+    )
+  )
+}
+
+#' @export
+print.ggplot2_cached_breaks <- function(x, ...) {
+  cat(format(x), sep = "")
+}

R/geom-histogram.R

@@ -133,6 +133,13 @@
 #' ggplot(economics_long, aes(value)) +
 #'   facet_wrap(~variable, scales = 'free_x') +
 #'   geom_histogram(binwidth = function(x) 2 * IQR(x) / (length(x)^(1/3)))
+#'
+#' # If you've already got your scale breaks set up how you want them, you can
+#' # tell stat_bin() to align bin edges with the breaks. This works best when
+#' # your scale uses fixed breaks, otherwise the breaks can be updated later
+#' ggplot(diamonds, aes(carat)) +
+#'   geom_histogram(follow.scale = "minor") +
+#'   scale_x_continuous(breaks = seq(0, 5, 0.5))
 geom_histogram <- function(mapping = NULL, data = NULL,
                            stat = "bin", position = "stack",
                            ...,

R/stat-bin.R

@@ -22,6 +22,12 @@
 #' @param breaks Alternatively, you can supply a numeric vector giving
 #'    the bin boundaries. Overrides `binwidth`, `bins`, `center`,
 #'    and `boundary`. Can also be a function that takes group-wise values as input and returns bin boundaries.
+#' @param follow.scale Alternatively, the bin edges can be copied from the scale
+#'    breaks, either `"major"` or `"minor"`. Ignored when `"off"`. Note that if
+#'    the scale's limits are updated by other layers or expansions then its
+#'    breaks are recomputed and might end up different to the value copied for
+#'    the bin edges. This is not an issue when the scale uses a fixed breaks
+#'    vector.
 #' @param closed One of `"right"` or `"left"` indicating whether right
 #'   or left edges of bins are included in the bin.
 #' @param pad If `TRUE`, adds empty bins at either end of x. This ensures
@@ -58,6 +64,7 @@ stat_bin <- function(mapping = NULL, data = NULL,
                      breaks = NULL,
                      closed = c("right", "left"),
                      pad = FALSE,
+                     follow.scale = "off",
                      na.rm = FALSE,
                      keep.zeroes = "all",
                      orientation = NA,
@@ -80,6 +87,7 @@ stat_bin <- function(mapping = NULL, data = NULL,
       breaks = breaks,
       closed = closed,
       pad = pad,
+      follow.scale = follow.scale,
       na.rm = na.rm,
       orientation = orientation,
       keep.zeroes = keep.zeroes,
@@ -136,7 +144,9 @@ StatBin <- ggproto("StatBin", Stat,
       cli::cli_abort("Only one of {.arg boundary} and {.arg center} may be specified in {.fn {snake_class(self)}}.")
     }
 
-    if (is.null(params$breaks) && is.null(params$binwidth) && is.null(params$bins)) {
+    params$follow.scale <- match.arg(params$follow.scale, c("off", "minor", "major"))
+
+    if (is.null(params$breaks) && is.null(params$binwidth) && is.null(params$bins) && (params$follow.scale == "off")) {
       cli::cli_inform("{.fn {snake_class(self)}} using {.code bins = 30}. Pick better value with {.arg binwidth}.")
       params$bins <- 30
     }
@@ -150,11 +160,17 @@ StatBin <- ggproto("StatBin", Stat,
                            center = NULL, boundary = NULL,
                            closed = c("right", "left"), pad = FALSE,
                            breaks = NULL, flipped_aes = FALSE, keep.zeroes = "all",
+                           follow.scale = "off",
                            # The following arguments are not used, but must
                            # be listed so parameters are computed correctly
                            origin = NULL, right = NULL, drop = NULL) {
     x <- flipped_names(flipped_aes)$x
-    if (!is.null(breaks)) {
+    if (follow.scale != "off") {
+      breaks <- switch(follow.scale,
+                       minor = scales[[x]]$get_breaks_minor(),
+                       major = scales[[x]]$get_breaks())
+      bins <- bin_breaks(breaks, closed)
+    } else if (!is.null(breaks)) {
       if (is.function(breaks)) {
         breaks <- breaks(data[[x]])
       }

_pkgdown.yml

@@ -116,6 +116,7 @@ reference:
   - expansion
   - starts_with("scale_")
   - get_alt_text
+  - breaks_cached
 
 - title: "Guides: axes and legends"
   desc: >