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