Add signed option for negative numbers in label_log()

DESCRIPTION

@@ -39,4 +39,4 @@ Config/testthat/edition: 3
 Encoding: UTF-8
 LazyLoad: yes
 Roxygen: list(markdown = TRUE, r6 = FALSE)
-RoxygenNote: 7.2.3
+RoxygenNote: 7.3.2

NAMESPACE

@@ -83,6 +83,7 @@ export(exp_trans)
 export(expand_range)
 export(extended_breaks)
 export(format_format)
+export(format_log)
 export(fullseq)
 export(gradient_n_pal)
 export(grey_pal)

NEWS.md

@@ -1,5 +1,8 @@
 # scales (development version)
 
+* `label_log()` has a `signed` argument for displaying negative numbers 
+  (@teunbrand, #421).
+
 # scales 1.3.0
 
 ## Better type support

R/label-log.R

@@ -1,30 +1,62 @@
 #' Label numbers in log format (10^3, 10^6, etc)
 #'
-#' `label_log()` displays numbers as base^exponent, using superscript formatting.
+#' `label_log()` and `format_log()` display numbers as base^exponent, using
+#' superscript formatting. `label_log()` returns expressions suitable for
+#' labelling in scales, whereas `format_log()` returns deparsed text.
 #'
+#'
+#' @param x A numeric vector to format
 #' @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()].
+#' @param signed Should a `+` or `-` be displayed as a prefix? The
+#'   default, `NULL`, displays signs if there are zeroes or negative numbers
+#'   present.
+#' @param ... Passed on to `format()`.
 #' @inherit label_number 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) {
+#' format_log(c(0.1, 1, 10))
+label_log <- function(base = 10, digits = 3, signed = NULL) {
   function(x) {
-    if (length(x) == 0) {
-      return(expression())
-    }
-
-    exponent <- format(log(x, base = base), digits = digits)
-    text <- paste0(base, "^", exponent)
+    text <- format_log(x, base = base, signed = signed, digits = digits)
     ret <- parse_safe(text)
-
     # restore NAs from input vector
     ret[is.na(x)] <- NA
-
     ret
   }
 }
+
+#' @export
+#' @rdname label_log
+format_log <- function(x, base = 10, signed = NULL, ...) {
+
+  if (length(x) == 0) {
+    return(character())
+  }
+  prefix <- rep("", length(x))
+  finites <- x[is.finite(x)]
+
+  signed <- signed %||% any(finites <= 0)
+  if (signed) {
+    sign <- sign(x)
+    prefix[sign == +1] <- "+"
+    prefix[sign == -1] <- "-"
+    x <- abs(x)
+    x[x == 0] <- 1
+  }
+
+  exponent <- format(zapsmall(log(x, base = base)), ...)
+  text <- paste0(prefix, base, "^", exponent)
+
+  if (signed) {
+    text[sign == 0] <- "0"
+  }
+  text[is.na(x)] <- NA
+
+  text
+}

tests/testthat/test-label-log.R

@@ -5,4 +5,5 @@ test_that("label_log() returns expression", {
   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))
+  expect_equal(label_log(signed = TRUE)(c(-100, 100)), expression(-10^2, +10^2))
 })