Implement label_log() (#312)

Fixes #311

NAMESPACE

@@ -84,6 +84,7 @@ export(label_comma)
 export(label_date)
 export(label_date_short)
 export(label_dollar)
+export(label_log)
 export(label_math)
 export(label_number)
 export(label_number_auto)

NEWS.md

@@ -39,6 +39,9 @@
 * Internal `precision()`, used when `accuracy = NULL`, now avoids displaying
   unnecessary digits (@davidchall, #304).
 
+* New `label_log()` displays the base and a superscript exponent, for use with
+  logarithmic axes (@davidchall, #312).
+
 # scales 1.1.1
 
 * `breaks_width()` now handles `difftime`/`hms` objects (@bhogan-mitre, #244).

R/label-expression.R

@@ -21,18 +21,10 @@
 #' # Use label_math() with continuous scales
 #' demo_continuous(c(1, 5))
 #' demo_continuous(c(1, 5), labels = label_math(alpha[.x]))
+#' demo_continuous(c(1, 5), labels = label_math())
 label_parse <- function() {
-  # From ggplot2:::parse_safe
-  # See https://github.com/tidyverse/ggplot2/issues/2864 for discussion.
   function(text) {
-    text <- as.character(text)
-
-    out <- vector("expression", length(text))
-    for (i in seq_along(text)) {
-      expr <- parse(text = text[[i]])
-      out[[i]] <- if (length(expr) == 0) NA else expr[[1]]
-    }
-    out
+    parse_safe(as.character(text))
   }
 }
 
@@ -68,3 +60,15 @@ parse_format <- label_parse
 #' @rdname label_parse
 #' @export
 math_format <- label_math
+
+
+# From ggplot2:::parse_safe
+# See https://github.com/tidyverse/ggplot2/issues/2864 for discussion.
+parse_safe <- function(text) {
+  out <- vector("expression", length(text))
+  for (i in seq_along(text)) {
+    expr <- parse(text = text[[i]])
+    out[[i]] <- if (length(expr) == 0) NA else expr[[1]]
+  }
+  out
+}

R/label-log.R

@@ -0,0 +1,30 @@
+#' Label numbers in log format (10^3, 10^6, etc)
+#'
+#' `label_log()` displays numbers as base^exponent, using superscript formatting.
+#'
+#' @param base Base of logarithm to use
+#' @param digits Number of significant digits to show for the exponent. Argument
+#'   is passed on to [base::format()].
+#' @inherit number_format return
+#' @seealso [breaks_log()] for the related breaks algorithm.
+#' @export
+#' @family labels for log scales
+#' @examples
+#' demo_log10(c(1, 1e5), labels = label_log())
+#' demo_log10(c(1, 1e5), breaks = breaks_log(base = 2), labels = label_log(base = 2))
+label_log <- function(base = 10, digits = 3) {
+  function(x) {
+    if (length(x) == 0) {
+      return(expression())
+    }
+
+    exponent <- format(log(x, base = base), digits = digits)
+    text <- paste0(base, "^", exponent)
+    ret <- parse_safe(text)
+
+    # restore NAs from input vector
+    ret[is.na(x)] <- NA
+
+    ret
+  }
+}

tests/testthat/test-label-log.R

@@ -0,0 +1,8 @@
+test_that("label_log() returns expression", {
+  expect_identical(label_log()(numeric()), expression())
+  expect_identical(label_log()(NA_real_), expression(NA))
+
+  expect_equal(label_log()(c(0.1, 10)), expression(10^-1, 10^1))
+  expect_equal(label_log(base = 2)(8), expression(2^3))
+  expect_equal(label_log(base = 2, digits = 3)(7), expression(2^2.81))
+})