Merge pull request #82 from qfes/diverging-scales

Diverging scales

DESCRIPTION

@@ -1,7 +1,7 @@
 Type: Package
 Package: rdeck
 Title: Deck.gl Widget
-Version: 0.4.0.9025
+Version: 0.4.0.9030
 Authors@R:
     person(given = "Anthony", family = "North", role = c("aut", "cre"), email = "anthony.jl.north@gmail.com")
 Description: Deck.gl widget for R.
@@ -37,7 +37,7 @@ LazyData: true
 Roxygen: list(
     markdown = TRUE,
     roclets = c("collate", "namespace", "rd", "roxyglobals::global_roclet"))
-RoxygenNote: 7.1.2
+RoxygenNote: 7.2.1
 Suggests:
     knitr,
     rmarkdown,

NAMESPACE

@@ -14,6 +14,16 @@ S3method(compile,scale_numeric_identity)
 S3method(compile,scale_numeric_quantile)
 S3method(compile,scale_numeric_quantize)
 S3method(compile,scale_numeric_threshold)
+S3method(rescale_center,scale_color)
+S3method(rescale_center,scale_color_category)
+S3method(rescale_center,scale_numeric)
+S3method(rescale_center,scale_numeric_category)
+S3method(rescale_center,scale_numeric_identity)
+S3method(rescale_diverge,scale_color)
+S3method(rescale_diverge,scale_color_category)
+S3method(rescale_diverge,scale_numeric)
+S3method(rescale_diverge,scale_numeric_category)
+S3method(rescale_diverge,scale_numeric_identity)
 S3method(tile_json,"NULL")
 S3method(tile_json,character)
 S3method(tile_json,mapbox)
@@ -106,6 +116,8 @@ export(rdeck)
 export(rdeckOutput)
 export(rdeck_proxy)
 export(renderRdeck)
+export(rescale_center)
+export(rescale_diverge)
 export(scale_category)
 export(scale_color_category)
 export(scale_color_linear)

NEWS.md

@@ -1,5 +1,6 @@
 # rdeck development version
 
+- Add centering, diverging scales (#82)
 - Add snapshot util (#77)
 - Add feature editor (#75)
 - Rewrite client api (#73)

R/rescale.R

@@ -0,0 +1,184 @@
+#' Rescale center
+#'
+#' @description
+#' Re-centers a scale to have a defined center / midpoint. This is the rdeck equivalent of
+#' [scales::rescale_mid()].
+#'
+#' Centering an rdeck scale creates a new scale with the output palette or range centered at `center`.
+#' This is similar to creating a diverging scale; the key difference is that the output palette or range
+#' remains linear (with respect to the breaks) and is truncated on the side that is closest to `center`.
+#' This is useful in creating _difference_ layer, where the output palette or range represents distance
+#' from the center.
+#'
+#' # Centering vs Diverging
+#' The plot below shows how [rescale_center()] and [rescale_diverge()] distort the scale output. The input
+#' scale in this case is `power_scale(limits = -36:4)`, centered and diverged at 0 (which is 0.75 on the
+#' original output).
+#'
+#' [rescale_diverge()] is creating a piecewise scale, so the two halves of the output ramp have a different slope;
+#' [rescale_center()] is keeping the output linear, but adjusting the slope such that y = 0.5 at x = 0.75 on
+#' the linear ramp.
+#'
+#' ![](rescale.png)
+#'
+#' @note
+#' Category and identity scales aren't supported.
+#'
+#' @examples
+#' # create a sqrt scale that is centered at 0
+#' sqrt_centered <- rescale_center(
+#'   scale_color_power(col, limits = -36:4),
+#'   center = 0
+#' )
+#'
+#' # create a discrete symlog scale that is centered at 5
+#' symlog_centered <- rescale_center(
+#'   scale_color_threshold(col, limits = -100:100, breaks = breaks_symlog()),
+#'   center = 5
+#' )
+#'
+#' @param scale <`scale`> a scale object
+#' @param center <`number`> the center of the scale input
+#' @family scales
+#' @export
+rescale_center <- function(scale, center = 0) {
+  UseMethod("rescale_center")
+}
+
+#' @export
+rescale_center.scale_color <- function(scale, center = 0) {
+  get_palette <- scale$get_palette
+
+  scale$get_palette <- function(x) {
+    xmid <- rescale_breaks(scale, center)
+    ramp <- scales::rescale_mid(x, mid = xmid)
+    get_palette(ramp)
+  }
+
+  scale
+}
+
+#' @export
+rescale_center.scale_numeric <- function(scale, center = 0) {
+  get_range <- scale$get_range
+
+  scale$get_range <- function(x) {
+    xmid <- rescale_breaks(scale, center)
+    ramp <- scales::rescale_mid(x, mid = xmid)
+    get_range(ramp)
+  }
+
+  scale
+}
+
+rescale_center_not_supported <- function(scale, center) {
+  rescale_not_supported("rescale_center()", scale$scale_type)
+}
+
+#' @export
+rescale_center.scale_numeric_identity <- rescale_center_not_supported
+
+#' @export
+rescale_center.scale_color_category <- rescale_center_not_supported
+
+#' @export
+rescale_center.scale_numeric_category <- rescale_center_not_supported
+
+
+#' Rescale diverge
+#'
+#' @description
+#' Creates a diverging scale with defined center / midpoint. Similar to [rescale_center()], key difference is
+#' the output palette / range is piecewise linear (with respect to breaks) and the entire output range is
+#' always used.
+#'
+#' @examples
+#' # create a diverging linear scale at 0
+#' linear_diverged <- rescale_diverge(
+#'   scale_color_linear(col, limits = -5:10),
+#'   center = 0
+#' )
+#'
+#' # create a diverging log scale at 10
+#' log_diverged <- rescale_diverge(
+#'   scale_log(col, limits = 1:1000),
+#'   center = 10
+#' )
+#' @inherit rescale_center
+#' @family scales
+#' @export
+#' @export
+rescale_diverge <- function(scale, center = 0) {
+  UseMethod("rescale_diverge")
+}
+
+#' @export
+rescale_diverge.scale_color <- function(scale, center = 0) {
+  get_palette <- scale$get_palette
+
+  scale$get_palette <- function(x) {
+    xmid <- rescale_breaks(scale, center)
+    ramp <- rescale_piecewise(x, xmid)
+    get_palette(ramp)
+  }
+
+  scale
+}
+
+#' @export
+rescale_diverge.scale_numeric <- function(scale, center = 0) {
+  get_range <- scale$get_range
+
+  scale$get_range <- function(x) {
+    xmid <- rescale_breaks(scale, center)
+    ramp <- rescale_piecewise(x, xmid)
+    get_range(ramp)
+  }
+
+  scale
+}
+
+rescale_diverge_not_supported <- function(scale, center) {
+  rescale_not_supported("rescale_diverge()", scale$scale_type)
+}
+
+#' @export
+rescale_diverge.scale_numeric_identity <- rescale_diverge_not_supported
+
+#' @export
+rescale_diverge.scale_color_category <- rescale_diverge_not_supported
+
+#' @export
+rescale_diverge.scale_numeric_category <- rescale_diverge_not_supported
+
+
+rescale_breaks <- function(scale, x) {
+  range <- (scale$limits %||% scale$data)$range
+  tidyassert::assert(x >= range[1] & x <= range[2])
+
+  # use transform if available
+  trans <- attr(scale$get_breaks, "trans")
+  if (!is.null(trans)) {
+    scales::rescale(trans$transform(x), from = trans$transform(range))
+  # approximate function from breaks
+  } else {
+    breaks <- scale$get_breaks(range)
+    rescale <- stats::splinefun(breaks, seq.int(0, 1, length.out = length(breaks)))
+    rescale(x)
+  }
+}
+
+rescale_piecewise <- function(x, mid) {
+  dplyr::case_when(
+    x == mid ~ 0.5,
+    x < mid ~ scales::rescale(x, c(0, 0.5), c(0, mid)),
+    x > mid ~ scales::rescale(x, c(0.5, 1), c(mid, 1))
+  )
+}
+
+rescale_not_supported <- function(rescale_fn, scale_type) {
+  rlang::abort(
+    paste(rescale_fn, "doesn't handle", scale_type, "scales."),
+    class = "rdeck_error"
+  )
+}

R/scale_breaks.R

@@ -73,7 +73,7 @@ breaks_trans <- function(n = 10, trans) {
   tidyassert::assert(scales::is.trans(trans))
 
   n_default <- n
-  function(x, n = n_default) {
+  breaks_fn <- function(x, n = n_default) {
     tidyassert::assert(rlang::is_scalar_integerish(n) && n >= 0)
 
     rng <- scales::train_continuous(x, c(-Inf, Inf))
@@ -88,6 +88,8 @@ breaks_trans <- function(n = 10, trans) {
     breaks <- trans$inverse(trans_breaks)
     c(rng[1], breaks[-c(1, n)], rng[2])
   }
+
+  structure(breaks_fn, trans = trans)
 }
 
 
@@ -178,14 +180,16 @@ breaks_log <- function(n = 10, base = exp(1)) {
   breaks_fn <- breaks_trans(n, log_trans(base))
   n_default <- n
 
-  function(x, n = n_default) {
+  wrapper_fn <- function(x, n = n_default) {
     tidyassert::assert(
       suppressWarnings(min(x, na.rm = TRUE) > 0 | max(x, na.rm = TRUE) < 0),
       "range must not contain, nor cross 0"
     )
 
     breaks_fn(x, n)
   }
+
+  structure(wrapper_fn, trans = attr(breaks_fn, "trans"))
 }
 
 

_pkgdown.yml

@@ -91,6 +91,7 @@ reference:
       and sizes: radius, elevation, width, height.
     contents:
       - matches("scale_")
+      - matches("rescale_")
 
   - title: Transformations
     desc: >