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