From 0f3929ac2b654aa8a5d43996c9515ff1f27b1cf7 Mon Sep 17 00:00:00 2001
From: Teun van den Brand <49372158+teunbrand@users.noreply.github.com>
Date: Tue, 22 Oct 2024 10:15:35 +0200
Subject: [PATCH] Label composer (#465)

---
 NAMESPACE                           |  1 +
 NEWS.md                             |  3 ++
 R/label-compose.R                   | 48 +++++++++++++++++++++++++++++
 _pkgdown.yml                        |  1 +
 man/compose_label.Rd                | 35 +++++++++++++++++++++
 tests/testthat/test-label-compose.R | 10 ++++++
 6 files changed, 98 insertions(+)
 create mode 100644 R/label-compose.R
 create mode 100644 man/compose_label.Rd
 create mode 100644 tests/testthat/test-label-compose.R

diff --git a/NAMESPACE b/NAMESPACE
index bf983f83..55a0fc31 100644
--- a/NAMESPACE
+++ b/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)
diff --git a/NEWS.md b/NEWS.md
index 5b5a5a75..6b24732b 100644
--- a/NEWS.md
+++ b/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
diff --git a/R/label-compose.R b/R/label-compose.R
new file mode 100644
index 00000000..d324c069
--- /dev/null
+++ b/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
+  }
+}
diff --git a/_pkgdown.yml b/_pkgdown.yml
index 12c48200..517a9750 100644
--- a/_pkgdown.yml
+++ b/_pkgdown.yml
@@ -19,6 +19,7 @@ reference:
   contents:
   - starts_with("label_")
   - matches("format")
+  - compose_label
   - number_options
 
 - title:  Axis breaks
diff --git a/man/compose_label.Rd b/man/compose_label.Rd
new file mode 100644
index 00000000..a9950860
--- /dev/null
+++ b/man/compose_label.Rd
@@ -0,0 +1,35 @@
+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/label-compose.R
+\name{compose_label}
+\alias{compose_label}
+\title{Compose two or more label formatters together}
+\usage{
+compose_label(..., call = caller_env())
+}
+\arguments{
+\item{...}{One or more labelling functions. These will be applied to breaks
+consecutively.
+\link[rlang:as_function]{Lambda syntax} is allowed.}
+
+\item{call}{A call to display in error messages.}
+}
+\value{
+A labelling function that applies the provided
+functions to breaks to return labels.
+}
+\description{
+This labeller provides a general mechanism for composing two or more
+labellers together.
+}
+\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"))
+)
+}
diff --git a/tests/testthat/test-label-compose.R b/tests/testthat/test-label-compose.R
new file mode 100644
index 00000000..d6ad3ab7
--- /dev/null
+++ b/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
+  )
+
+})