R/rescaling.R

In teunbrand/ggvctrcoords: Coordinates and scales for ggplot2 using the vctrs package

# rescale -----------------------------------------------------------------

#' Rescale vector to have a specified minimum and maximum
#'
#' Mimicking \code{\link[scales]{rescale}}, but more type stable.
#'
#' @param x A vector to manipulate
#' @param to An output range
#' @param from The input range
#' @param ... Possible other arguments to downstream functions
#'
#' @details The default method should in theory be type stable as long as
#'   \code{x} can be cast without loss as \code{numeric} and vice versa and has
#'   a type stable \code{range} function. Will throw an error upon lossy casts,
#'   unless wrapped in \code{vctrs::allow_lossy_cast}.
#'
#' @return A vector of the same length as \code{x}
#' @export
#'
#' @examples
#' # Note that 1:10 returns integers, not doubles
#' vec_rescale(as.numeric(1:10))
#' vctrs::allow_lossy_cast(vec_rescale(1:10))
vec_rescale <- function(x, to, from, ...) {
  UseMethod("vec_rescale")
}

#' @method vec_rescale default
#' @export vec_rescale.default
#' @export
#' @rdname vec_rescale
vec_rescale.default <- function(
  x, to = c(0, 1),
  from = range(x, na.rm = TRUE, finite = TRUE),
  ...) {
  UseMethod("vec_rescale.default", to)
}

# Indeed, down the rabbithole we go!
# The nestedness is needed here when `x` is a numeric that needs to be rescaled
# according to a `from` argument that could be a vctr
#' @method vec_rescale.default default
#' @export vec_rescale.default.default
#' @export
#' @rdname vec_rescale
vec_rescale.default.default <- function(
  x, to = c(0, 1),
  from = range(x, na.rm = TRUE, finite = TRUE),
  ...) {
  from <- force(from)
  UseMethod("vec_rescale.default.default", from)
}

# Ugh, that moment when you start to miss S4...
#' @export
#' @method vec_rescale.default.default default
vec_rescale.default.default.default <- function(
  x, to = c(0, 1),
  from = range(x, na.rm = TRUE, finite = TRUE),
  ...) {
  ans <- scales::rescale(as.numeric(x), to, from, ...)
  ans <- vec_cast(ans, x)
  ans
}

# Force flat --------------------------------------------------------------

#' Make a vector flat
#'
#' Given the standardised name of an aesthetic and limits, force a vector to be
#' a plain numeric number.
#'
#' @param x A vector
#' @param limits The limits for which the minimum should become 0 and the
#'   maximum 1.
#' @param method The name of the aesthetic being evaluated.
#'
#' @details This is function is often invoked at the very last step before
#'   ggplot hands off the data to the grid package and this generic's methods
#'   therefore should return a plain numeric between 0-1.
#'
#'   The default coerces \code{x} to a numeric and uses \code{scales::rescale}
#'   to rescale the values to a  range between 0 and 1.
#'
#' @return A numeric vector between 0-1.
#' @export
#'
#' @examples
#' vec_force_flat(5:10, c(0, 15), method = "x")
vec_force_flat <- function(x, limits = NULL, method = NA_character_) {
  UseMethod("vec_force_flat")
}

#' @export
#' @export vec_force_flat.default
#' @method vec_force_flat default
#' @rdname vec_force_flat
vec_force_flat.default <- function(x, limits = NULL, method = NA_character_) {
  UseMethod("vec_force_flat.default", limits)
}

#' @method vec_force_flat.default default
#' @export
vec_force_flat.default.default <- function(x, limits = NULL, method = NA_character_) {
  vec_assert(method, character())
  x <- switch(method, as.numeric(x))
  scales::rescale(x, to = c(0, 1), from = limits)
}