Label composer

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

@@ -71,6 +71,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

@@ -1,5 +1,8 @@
 # scales (development version)
 
+* 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") <- 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
 
 - title:  Axis breaks
   desc: >

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
+  )
+
+})