Label composer (#465)

NAMESPACE

@@ -74,6 +74,7 @@ export(col_shift)
 export(colour_ramp)
 export(comma)
 export(comma_format)
+export(compose_label)
 export(compose_trans)
 export(cscale)
 export(cut_long_scale)

NEWS.md

@@ -11,6 +11,9 @@
 * `label_log()` has a `signed` argument for displaying negative numbers 
   (@teunbrand, #421).
 
+* New function `compose_label()` to chain together label formatting functions 
+  (#462)
+
 # scales 1.3.0
 
 ## Better type support

R/label-compose.R

@@ -0,0 +1,48 @@
+#' Compose two or more label formatters together
+#'
+#' This labeller provides a general mechanism for composing two or more
+#' labellers together.
+#'
+#' @param ... One or more labelling functions. These will be applied to breaks
+#'   consecutively.
+#'   [Lambda syntax][rlang::as_function] is allowed.
+#' @param call A call to display in error messages.
+#'
+#' @return A labelling function that applies the provided
+#'   functions to breaks to return labels.
+#'
+#' @export
+#'
+#' @examples
+#' demo_continuous(
+#'   c(-100, 100),
+#'   labels = compose_label(abs, number, ~paste0(.x, " foobar"), toupper)
+#' )
+#'
+#' # Same result
+#' demo_continuous(
+#'   c(-100, 100),
+#'   labels = compose_label(abs, label_number(suffix = " FOOBAR"))
+#' )
+compose_label <- function(..., call = caller_env()) {
+
+  label_list <- list2(...)
+  if (length(label_list) == 0) {
+    return(identity)
+  }
+  label_list <- lapply(label_list, as_function, call = call)
+
+  function(x) {
+    if (length(x) == 0) {
+      return(character())
+    }
+    orig <- x
+    for (labeller in label_list) {
+      x <- labeller(x)
+      attr(x, "orig_breaks") <- orig
+    }
+    x[is.na(orig)] <- NA
+    names(x) <- names(x) %||% names(orig)
+    x
+  }
+}

_pkgdown.yml

@@ -19,6 +19,7 @@ reference:
   contents:
   - starts_with("label_")
   - matches("format")
+  - compose_label
   - number_options
 
 - title:  Axis breaks

tests/testthat/test-label-compose.R

@@ -0,0 +1,10 @@
+test_that("compose_labels can chain together functions", {
+
+  labeller <- compose_label(`-`, label_number(suffix = " foo"), toupper)
+  expect_equal(
+    labeller(c(0.1, 1.0, 10.0)),
+    c("-0.1 FOO", "-1.0 FOO", "-10.0 FOO"),
+    ignore_attr = TRUE
+  )
+
+})