Add scale

NAMESPACE

@@ -80,6 +80,7 @@ export(palette_color_continuous)
 export(palette_color_discrete)
 export(palette_shape)
 export(palette_size)
+export(scale_midpoint)
 export(scale_range)
 export(validate)
 exportMethods(append_rownames)

R/transform.R

@@ -1,16 +1,33 @@
 # DATA TRANSFORMATION
 NULL
 
-#' Rescale Continuous Vector
+#' Rescale Continuous Vector (minimum, maximum)
 #'
 #' Rescales continuous vector to have specified minimum and maximum.
 #' @param x A [`numeric`] vector.
 #' @param to A length-two [`numeric`] vector specifying the output range.
 #' @param from A length-two [`numeric`] vector specifying the input range.
-#' @note For internal use only.
 #' @return A [`numeric`] vector.
+#' @note For internal use only.
 #' @family data transformation tools
 #' @export
 scale_range <- function(x, to = c(0, 1), from = range(x, finite = TRUE)) {
   (x - from[1L]) / diff(from) * diff(to) + to[1L]
 }
+
+#' Rescale Continuous Vector (minimum, midpoint, maximum)
+#'
+#' Rescales continuous vector to have specified minimum, midpoint and maximum.
+#' @param x A [`numeric`] vector.
+#' @param to A length-two [`numeric`] vector specifying the output range.
+#' @param from A length-two [`numeric`] vector specifying the input range.
+#' @param midpoint A length-one [`numeric`] vector specifying the mid-point of input
+#'  range.
+#' @return A [`numeric`] vector.
+#' @note For internal use only.
+#' @family data transformation tools
+#' @export
+scale_midpoint <- function(x, to = c(0, 1), from = range(x, finite = TRUE), midpoint = 0) {
+  extent <- 2 * max(abs(from - midpoint))
+  (x - midpoint) / extent * diff(to) + mean(to)
+}

inst/tinytest/test_scale.R

@@ -1,5 +1,6 @@
 # Rescale continuous vector ====================================================
 expect_identical(scale_range(5:10), c(0, 0.2, 0.4, 0.6, 0.8, 1))
+expect_identical(scale_midpoint(5:10, to = c(0, 5)), c(3.75, 4, 4.25, 4.5, 4.75, 5))
 
 # Label percentage =============================================================
 expect_identical(label_percent(c(0.01, 0.5), trim = FALSE), c(" 1%", "50%"))