Improve exponential breaks (#454)

NAMESPACE

@@ -52,6 +52,7 @@ export(asinh_trans)
 export(asn_trans)
 export(atanh_trans)
 export(boxcox_trans)
+export(breaks_exp)
 export(breaks_extended)
 export(breaks_log)
 export(breaks_pretty)

NEWS.md

@@ -1,5 +1,7 @@
 # scales (development version)
 
+* `transform_exp()` now has more sensible breaks, available in `breaks_exp()` 
+  (@teunbrand, #405).
 * The scales package now keeps track of known palettes. These can be retrieved
   using `get_palette()` or registered using `set_palette()` (#396).
 * `label_log()` has a `signed` argument for displaying negative numbers 

R/breaks.R

@@ -182,3 +182,31 @@ breaks_timespan <- function(unit = c("secs", "mins", "hours", "days", "weeks"),
     as.difftime(breaks * scale, units = "secs")
   }
 }
+
+#' Breaks for exponentially transformed data
+#'
+#' This breaks function typically labels zero and the last `n - 1` integers of a
+#' range if that range is large enough (currently: 3). For smaller ranges, it
+#' uses [`breaks_extended()`].
+#'
+#' @inheritParams breaks_extended
+#' @export
+#' @examples
+#' # Small range
+#' demo_continuous(c(100, 102), transform = "exp", breaks = breaks_exp())
+#' # Large range
+#' demo_continuous(c(0, 100), transform = "exp", breaks = breaks_exp(n = 4))
+breaks_exp <- function(n = 5, ...) {
+  n_default <- n
+  default <- extended_breaks(n = n_default, ...)
+  function(x, n = n_default) {
+    # Discard -Infs
+    x <- sort(pmax(x, 0))
+    top <- floor(x[2])
+    if (top >= 3 && abs(diff(x)) >= 3) {
+      unique(c(top - seq_len(min(top, n_default - 1)) + 1, 0))
+    } else {
+      default(x)
+    }
+  }
+}

R/transform-numeric.R

@@ -255,7 +255,8 @@ transform_exp <- function(base = exp(1)) {
     function(x) base^x,
     function(x) log(x, base = base),
     d_transform = function(x) base^x * log(base),
-    d_inverse = function(x) 1 / x / log(base)
+    d_inverse = function(x) 1 / x / log(base),
+    breaks = breaks_exp(),
   )
 }
 

tests/testthat/test-breaks.R

@@ -30,3 +30,18 @@ test_that("breaks_pretty() arguments are forcely evaluated on each call #81", {
   expect_equal(subfun1(1), subfuns[[1]](1))
   expect_equal(subfun2(1), subfuns[[2]](1))
 })
+
+test_that("exponential breaks give sensible values", {
+
+  x <- breaks_exp()(c(0, 2))
+  expect_equal(x, c(0, 0.5, 1, 1.5, 2))
+
+  x <- breaks_exp()(c(0, 5))
+  expect_equal(x, c(5, 4, 3, 2, 0))
+
+  x <- breaks_exp()(c(100, 102))
+  expect_equal(x, c(0, 0.5, 1, 1.5, 2) + 100)
+
+  x <- breaks_exp()(c(0, 100))
+  expect_equal(x, c(100, 99, 98, 97, 0))
+})