Transform midpoint argument in relevant scales (#5518)

* transform midpoint

* add test

* check_transformation takes an argument name to report

* handle transformation in `mid_rescaler()`

* repeat less

* add news bullet

* redocument

* Better call wiring

* update trans -> transform

NEWS.md

@@ -1,5 +1,9 @@
 # ggplot2 (development version)
 
+* (breaking) In the `scale_{colour/fill}_gradient2()` and 
+  `scale_{colour/fill}_steps2()` functions, the `midpoint` argument is 
+  transformed by the scale transformation (#3198).
+
 * `guide_colourbar()` and `guide_coloursteps()` gain an `alpha` argument to
   set the transparency of the bar (#5085).
 

R/scale-.R

@@ -609,7 +609,7 @@ check_breaks_labels <- function(breaks, labels, call = NULL) {
 default_transform <- function(self, x) {
   transformation <- self$get_transformation()
   new_x <- transformation$transform(x)
-  check_transformation(x, new_x, self$transformation$name, self$call)
+  check_transformation(x, new_x, self$transformation$name, call = self$call)
   new_x
 }
 
@@ -1329,13 +1329,17 @@ scale_flip_position <- function(scale) {
   invisible()
 }
 
-check_transformation <- function(x, transformed, name, call = NULL) {
-  if (any(is.finite(x) != is.finite(transformed))) {
-    cli::cli_warn(
-      "{.field {name}} transformation introduced infinite values.",
-      call = call
-    )
+check_transformation <- function(x, transformed, name, arg = NULL, call = NULL) {
+  if (!any(is.finite(x) != is.finite(transformed))) {
+    return(invisible())
+  }
+  if (is.null(arg)) {
+    end <- "."
+  } else {
+    end <- paste0(" in {.arg {arg}}.")
   }
+  msg <- paste0("{.field {name}} transformation introduced infinite values", end)
+  cli::cli_warn(msg, call = call)
 }
 
 trans_support_nbreaks <- function(trans) {

R/scale-gradient.R

@@ -90,37 +90,47 @@ scale_fill_gradient <- function(..., low = "#132B43", high = "#56B1F7", space =
 }
 
 #' @inheritParams scales::pal_div_gradient
+#' @inheritParams continuous_scale
 #' @param midpoint The midpoint (in data value) of the diverging scale.
 #'   Defaults to 0.
 #' @rdname scale_gradient
 #' @export
 scale_colour_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
-                                   midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar",
+                                   midpoint = 0, space = "Lab", na.value = "grey50",
+                                   transform = "identity", guide = "colourbar",
                                    aesthetics = "colour") {
   continuous_scale(
     aesthetics,
-    palette = pal_div_gradient(low, mid, high, space),
-    na.value = na.value, guide = guide, ...,
-    rescaler = mid_rescaler(mid = midpoint)
+    palette = div_gradient_pal(low, mid, high, space),
+    na.value = na.value, transform = transform, guide = guide, ...,
+    rescaler = mid_rescaler(mid = midpoint, transform = transform)
   )
 }
 
 #' @rdname scale_gradient
 #' @export
 scale_fill_gradient2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
-                                 midpoint = 0, space = "Lab", na.value = "grey50", guide = "colourbar",
+                                 midpoint = 0, space = "Lab", na.value = "grey50",
+                                 transform = "identity", guide = "colourbar",
                                  aesthetics = "fill") {
   continuous_scale(
     aesthetics,
-    palette = pal_div_gradient(low, mid, high, space),
-    na.value = na.value, guide = guide, ...,
-    rescaler = mid_rescaler(mid = midpoint)
+    palette = div_gradient_pal(low, mid, high, space),
+    na.value = na.value, transform = transform, guide = guide, ...,
+    rescaler = mid_rescaler(mid = midpoint, transform = transform)
   )
 }
 
-mid_rescaler <- function(mid) {
+mid_rescaler <- function(mid, transform = "identity",
+                         arg = caller_arg(mid), call = caller_env()) {
+  transform <- as.trans(transform)
+  trans_mid <- transform$transform(mid)
+  check_transformation(
+    mid, trans_mid, transform$name,
+    arg = arg, call = call
+  )
   function(x, to = c(0, 1), from = range(x, na.rm = TRUE)) {
-    rescale_mid(x, to, from, mid)
+    rescale_mid(x, to, from, trans_mid)
   }
 }
 

R/scale-steps.R

@@ -52,10 +52,13 @@ scale_colour_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "
 #' @rdname scale_steps
 #' @export
 scale_colour_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
-                                midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps",
+                                midpoint = 0, space = "Lab", na.value = "grey50",
+                                transform = "identity", guide = "coloursteps",
                                 aesthetics = "colour") {
-  binned_scale(aesthetics, palette = pal_div_gradient(low, mid, high, space),
-               na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...)
+  binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space),
+               na.value = na.value, transform = transform, guide = guide,
+               rescaler = mid_rescaler(mid = midpoint, transform = transform),
+               ...)
 }
 #' @rdname scale_steps
 #' @export
@@ -75,10 +78,12 @@ scale_fill_steps <- function(..., low = "#132B43", high = "#56B1F7", space = "La
 #' @rdname scale_steps
 #' @export
 scale_fill_steps2 <- function(..., low = muted("red"), mid = "white", high = muted("blue"),
-                              midpoint = 0, space = "Lab", na.value = "grey50", guide = "coloursteps",
+                              midpoint = 0, space = "Lab", na.value = "grey50",
+                              transform = "identity", guide = "coloursteps",
                               aesthetics = "fill") {
-  binned_scale(aesthetics, palette = pal_div_gradient(low, mid, high, space),
-               na.value = na.value, guide = guide, rescaler = mid_rescaler(mid = midpoint), ...)
+  binned_scale(aesthetics, palette = div_gradient_pal(low, mid, high, space),
+               na.value = na.value, transform = transform, guide = guide,
+               rescaler = mid_rescaler(mid = midpoint, transform = transform), ...)
 }
 #' @rdname scale_steps
 #' @export

tests/testthat/test-scale-gradient.R

@@ -9,3 +9,19 @@ test_that("points outside the limits are plotted as NA", {
   correct_fill <- c("#B26D65", "#DCB4AF", "orange")
   expect_equal(layer_data(p)$fill, correct_fill)
 })
+
+test_that("midpoints are transformed", {
+
+  scale <- scale_colour_gradient2(midpoint = 1, trans = "identity")
+  scale$train(c(0, 3))
+  expect_equal(scale$rescale(c(0, 3)), c(0.25, 1))
+
+  scale <- scale_colour_gradient2(midpoint = 10, trans = "log10")
+  scale$train(scale$transform(c(1, 1000)))
+  ans <- scale$rescale(c(0, 3), c(0.25, 1))
+
+  expect_warning(
+    scale_colour_gradient2(midpoint = 0, transform = "log10"),
+    "introduced infinite values"
+  )
+})