From b0fc13b56f5ea81b4fbb1e81c0d6399fc1143a5a Mon Sep 17 00:00:00 2001 From: Hadley Wickham Date: Thu, 24 Mar 2022 14:22:10 -0500 Subject: [PATCH] Implement transformer composition (#335) Fixes #287 --- DESCRIPTION | 5 ++- NAMESPACE | 1 + NEWS.md | 6 +++ R/trans-compose.R | 51 +++++++++++++++++++++++++ R/trans.r | 21 +++++++--- man/compose_trans.Rd | 21 ++++++++++ man/trans_new.Rd | 2 +- scales.Rproj | 1 + tests/testthat/_snaps/colour-mapping.md | 6 ++- tests/testthat/_snaps/trans-compose.md | 13 +++++++ tests/testthat/_snaps/trans.md | 20 ++++++++++ tests/testthat/test-trans-compose.R | 17 +++++++++ tests/testthat/test-trans.r | 22 +++++++++++ 13 files changed, 175 insertions(+), 11 deletions(-) create mode 100644 R/trans-compose.R create mode 100644 man/compose_trans.Rd create mode 100644 tests/testthat/_snaps/trans-compose.md create mode 100644 tests/testthat/_snaps/trans.md create mode 100644 tests/testthat/test-trans-compose.R diff --git a/DESCRIPTION b/DESCRIPTION index 10886bbb..c63088da 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -20,7 +20,7 @@ Imports: munsell (>= 0.5), R6, RColorBrewer, - rlang, + rlang (>= 1.0.0), viridisLite Suggests: bit64, @@ -29,7 +29,8 @@ Suggests: ggplot2, hms (>= 0.5.0), stringi, - testthat (>= 3.0.0) + testthat (>= 3.0.0), + waldo (>= 0.4.0) Config/Needs/website: tidyverse/tidytemplate Encoding: UTF-8 LazyLoad: yes diff --git a/NAMESPACE b/NAMESPACE index ff54ab3a..398c5108 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -52,6 +52,7 @@ export(col_quantile) export(colour_ramp) export(comma) export(comma_format) +export(compose_trans) export(cscale) export(date_breaks) export(date_format) diff --git a/NEWS.md b/NEWS.md index b4ab395d..7d03e979 100644 --- a/NEWS.md +++ b/NEWS.md @@ -1,5 +1,11 @@ # scales (development version) +* New `compose_trans()` allows arbitrary composition of transformers. This + is mostly easily achieved by passing a character vector whenever you might + previously have passed the name of a single transformer. For example, + `scale_y_continuous(trans = c("log10", "reverse"))` will create a + reverse log-10 scale (#287). + * `time_trans()` and `date_trans()` have `domains` of the correct type so that they can be transformed without error (#298). diff --git a/R/trans-compose.R b/R/trans-compose.R new file mode 100644 index 00000000..c2596da5 --- /dev/null +++ b/R/trans-compose.R @@ -0,0 +1,51 @@ +#' Compose two or more transformations together +#' +#' This transformer provides a general mechanism for composing two or more +#' transformers together. The most important use case is to combine reverse +#' with other transformations. +#' +#' @param ... One or more transformers, either specified with string or +#' as individual transformer objects. +#' @export +#' @examples +#' demo_continuous(10^c(-2:4), trans = "log10", labels = label_log()) +#' demo_continuous(10^c(-2:4), trans = c("log10", "reverse"), labels = label_log()) +compose_trans <- function(...) { + trans_list <- lapply(list2(...), as.trans) + if (length(trans_list) == 0) { + abort("Must include at least 1 transformer to compose") + } + + # Resolve domains + suppressWarnings( + domain <- compose_fwd(trans_list[[1]]$domain, trans_list[-1]) + ) + if (any(is.na(domain))) { + abort("Sequence of transformations yields invalid domain") + } + domain <- range(domain) + + names <- vapply(trans_list, "[[", "name", FUN.VALUE = character(1)) + + trans_new( + paste0("composition(", paste0(names, collapse = ","), ")"), + transform = function(x) compose_fwd(x, trans_list), + inverse = function(x) compose_rev(x, trans_list), + breaks = function(x) trans_list[[1]]$breaks(x), + domain = domain + ) +} + +compose_fwd <- function(x, trans_list) { + for (trans in trans_list) { + x <- trans$transform(x) + } + x +} + +compose_rev <- function(x, trans_list) { + for (trans in rev(trans_list)) { + x <- trans$inverse(x) + } + x +} diff --git a/R/trans.r b/R/trans.r index 9aaec889..93849a3b 100644 --- a/R/trans.r +++ b/R/trans.r @@ -48,7 +48,10 @@ trans_new <- function(name, transform, inverse, breaks = extended_breaks(), is.trans <- function(x) inherits(x, "trans") #' @export -print.trans <- function(x, ...) cat("Transformer: ", x$name, "\n") +print.trans <- function(x, ...) { + cat("Transformer: ", x$name, " [", x$domain[[1]], ", ", x$domain[[2]], "]\n", sep = "") + invisible(x) +} #' @export plot.trans <- function(x, y, ..., xlim, ylim = NULL) { @@ -79,13 +82,19 @@ lines.trans <- function(x, ..., xlim) { #' @rdname trans_new #' @export -as.trans <- function(x) { +as.trans <- function(x, arg = deparse(substitute(x))) { if (is.trans(x)) { - return(x) + x + } else if (is.character(x) && length(x) >= 1) { + if (length(x) == 1) { + f <- paste0(x, "_trans") + match.fun(f)() + } else { + compose_trans(!!!x) + } + } else { + abort(sprintf("`%s` must be a character vector or a transformer object", arg)) } - - f <- paste0(x, "_trans") - match.fun(f)() } #' Compute range of transformed values diff --git a/man/compose_trans.Rd b/man/compose_trans.Rd new file mode 100644 index 00000000..4af20e58 --- /dev/null +++ b/man/compose_trans.Rd @@ -0,0 +1,21 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/trans-compose.R +\name{compose_trans} +\alias{compose_trans} +\title{Compose two or more transformations together} +\usage{ +compose_trans(...) +} +\arguments{ +\item{...}{One or more transformers, either specified with string or +as individual transformer objects.} +} +\description{ +This transformer provides a general mechanism for composing two or more +transformers together. The most important use case is to combine reverse +with other transformations. +} +\examples{ +demo_continuous(10^c(-2:4), trans = "log10", labels = label_log()) +demo_continuous(10^c(-2:4), trans = c("log10", "reverse"), labels = label_log()) +} diff --git a/man/trans_new.Rd b/man/trans_new.Rd index 3b04612f..00d59b0c 100644 --- a/man/trans_new.Rd +++ b/man/trans_new.Rd @@ -19,7 +19,7 @@ trans_new( is.trans(x) -as.trans(x) +as.trans(x, arg = deparse(substitute(x))) } \arguments{ \item{name}{transformation name} diff --git a/scales.Rproj b/scales.Rproj index cba1b6b7..edce964f 100644 --- a/scales.Rproj +++ b/scales.Rproj @@ -17,5 +17,6 @@ StripTrailingWhitespace: Yes BuildType: Package PackageUseDevtools: Yes +PackageCleanBeforeInstall: Yes PackageInstallArgs: --no-multiarch --with-keep.source PackageRoxygenize: rd,collate,namespace diff --git a/tests/testthat/_snaps/colour-mapping.md b/tests/testthat/_snaps/colour-mapping.md index 08e3ba03..60764024 100644 --- a/tests/testthat/_snaps/colour-mapping.md +++ b/tests/testthat/_snaps/colour-mapping.md @@ -3,10 +3,12 @@ Code x <- c(1:5, rep(10, 10)) col <- col_quantile("RdYlBu", domain = x, n = 7)(x) - Warning + Condition + Warning: Skewed data means we can only allocate 4 unique colours not the 7 requested Code col <- col_quantile("RdYlBu", domain = NULL, n = 7)(x) - Warning + Condition + Warning: Skewed data means we can only allocate 4 unique colours not the 7 requested diff --git a/tests/testthat/_snaps/trans-compose.md b/tests/testthat/_snaps/trans-compose.md new file mode 100644 index 00000000..4d362c7b --- /dev/null +++ b/tests/testthat/_snaps/trans-compose.md @@ -0,0 +1,13 @@ +# produces informative errors + + Code + compose_trans() + Condition + Error in `compose_trans()`: + ! Must include at least 1 transformer to compose + Code + compose_trans("reverse", "log10") + Condition + Error in `compose_trans()`: + ! Sequence of transformations yields invalid domain + diff --git a/tests/testthat/_snaps/trans.md b/tests/testthat/_snaps/trans.md new file mode 100644 index 00000000..e5b33823 --- /dev/null +++ b/tests/testthat/_snaps/trans.md @@ -0,0 +1,20 @@ +# as.trans generates informative error + + Code + as.trans(1) + Condition + Error in `as.trans()`: + ! `1` must be a character vector or a transformer object + Code + as.trans("x") + Condition + Error in `get()`: + ! object 'x_trans' of mode 'function' was not found + +# trans has useful print method + + Code + trans_new("test", transform = identity, inverse = identity) + Output + Transformer: test [-Inf, Inf] + diff --git a/tests/testthat/test-trans-compose.R b/tests/testthat/test-trans-compose.R new file mode 100644 index 00000000..d564fd4f --- /dev/null +++ b/tests/testthat/test-trans-compose.R @@ -0,0 +1,17 @@ +test_that("composes transforms correctly", { + t <- compose_trans("log10", "reverse") + expect_equal(t$transform(100), -2) + expect_equal(t$inverse(-2), 100) +}) + +test_that("uses breaks from first transformer", { + t <- compose_trans("log10", "reverse") + expect_equal(t$breaks(c(1, 1000)), log_breaks()(c(1, 1000))) +}) + +test_that("produces informative errors", { + expect_snapshot(error = TRUE, { + compose_trans() + compose_trans("reverse", "log10") + }) +}) diff --git a/tests/testthat/test-trans.r b/tests/testthat/test-trans.r index 696c0f32..d07a29b1 100644 --- a/tests/testthat/test-trans.r +++ b/tests/testthat/test-trans.r @@ -5,3 +5,25 @@ test_that("Transformed ranges silently drop out-of-domain values", { r2 <- trans_range(sqrt_trans(), -1:10) expect_equal(r2, sqrt(c(0, 10))) }) + + +test_that("as.trans handles character inputs", { + expect_equal(as.trans("log10"), log10_trans()) + expect_equal( + as.trans(c("log10", "reverse")), + compose_trans(log10_trans(), reverse_trans()) + ) +}) + +test_that("as.trans generates informative error", { + expect_snapshot(error = TRUE, { + as.trans(1) + as.trans("x") + }) +}) + +test_that("trans has useful print method", { + expect_snapshot({ + trans_new("test", transform = identity, inverse = identity) + }) +})