1#' Arbitrary colour gradient palette (continuous)
2#'
3#' @param colours vector of colours
4#' @param values if colours should not be evenly positioned along the gradient
5#'   this vector gives the position (between 0 and 1) for each colour in the
6#'   `colours` vector. See [rescale()] for a convenience function
7#'   to map an arbitrary range to between 0 and 1.
8#' @param space colour space in which to calculate gradient. Must be "Lab" -
9#'   other values are deprecated.
10#' @export
11
12gradient_n_pal <- function(colours, values = NULL, space = "Lab") {
13  if (!identical(space, "Lab")) {
14    warning("Non Lab interpolation is deprecated", call. = FALSE)
15  }
16  ramp <- colour_ramp(colours)
17  force(values)
18
19  function(x) {
20    if (length(x) == 0) return(character())
21
22    if (!is.null(values)) {
23      xs <- seq(0, 1, length.out = length(values))
24      f <- stats::approxfun(values, xs)
25      x <- f(x)
26    }
27
28    ramp(x)
29  }
30}
31
32#' Diverging colour gradient (continuous).
33#'
34#' @param low colour for low end of gradient.
35#' @param mid colour for mid point
36#' @param high colour for high end of gradient.
37#' @inheritParams gradient_n_pal
38#' @export
39#' @examples
40#' x <- seq(-1, 1, length.out = 100)
41#' r <- sqrt(outer(x^2, x^2, "+"))
42#' image(r, col = div_gradient_pal()(seq(0, 1, length.out = 12)))
43#' image(r, col = div_gradient_pal()(seq(0, 1, length.out = 30)))
44#' image(r, col = div_gradient_pal()(seq(0, 1, length.out = 100)))
45#'
46#' library(munsell)
47#' image(r, col = div_gradient_pal(low =
48#'    mnsl(complement("10R 4/6"), fix = TRUE))(seq(0, 1, length = 100)))
49#' @importFrom munsell mnsl
50div_gradient_pal <- function(low = mnsl("10B 4/6"), mid = mnsl("N 8/0"), high = mnsl("10R 4/6"), space = "Lab") {
51  gradient_n_pal(c(low, mid, high), space = space)
52}
53
54#' Sequential colour gradient palette (continuous)
55#'
56#' @param low colour for low end of gradient.
57#' @param high colour for high end of gradient.
58#' @inheritParams gradient_n_pal
59#' @export
60#' @examples
61#' x <- seq(0, 1, length.out = 25)
62#' show_col(seq_gradient_pal()(x))
63#' show_col(seq_gradient_pal("white", "black")(x))
64#'
65#' library(munsell)
66#' show_col(seq_gradient_pal("white", mnsl("10R 4/6"))(x))
67seq_gradient_pal <- function(low = mnsl("10B 4/6"), high = mnsl("10R 4/6"), space = "Lab") {
68  gradient_n_pal(c(low, high), space = space)
69}
70