Samuel Granjeaud IR/Inserm
2025-Aug-28 19:07 UTC
[R] grDevices- Feature proposal: color interpolation in color spaces of convertColor
Hi,
I needed to interpolate in the CIE XYZ color space, but the default
colorRamp function does not exploit the color spaces available in
colorConvert function. Please find below a few changes to colorRamp that
permits to extend the choice of color spaces.
Best,
Samuel
colorRamp <- function(
??? colors, bias = 1,
??? space = c("rgb","Lab", "XYZ", "Apple
RGB", "CIE RGB", "Luv"),
??? interpolate = c("linear","spline"), alpha = FALSE)
{
? if (bias <= 0) stop("'bias' must be positive")
? if (!missing(space) && alpha)
??? stop("'alpha' must be false if 'space' is
specified")
? colors <- t(col2rgb(colors, alpha = alpha)/255)
? space <- match.arg(space)
? interpolate <- match.arg(interpolate)
? if (space != "rgb")
??? colors <- convertColor(colors, from = "sRGB", to = space)
? interpolate <- switch(interpolate,
??????????????????????? linear = stats::approxfun,
??????????????????????? spline = stats::splinefun)
? if((nc <- nrow(colors)) == 1L) {
??? colors <- colors[c(1L, 1L) ,]
??? nc <- 2L
? }
? x <- seq.int(0, 1, length.out = nc)^bias
? palette <- c(interpolate(x, colors[, 1L]),
?????????????? interpolate(x, colors[, 2L]),
?????????????? interpolate(x, colors[, 3L]),
?????????????? if(alpha) interpolate(x, colors[, 4L]))
? roundcolor <- function(rgb) ## careful to preserve matrix:
??? pmax(pmin(rgb, 1), 0)
? if (space != "rgb")
??? function(x)
????? roundcolor(convertColor(cbind(palette[[1L]](x),
??????????????????????????????????? palette[[2L]](x),
??????????????????????????????????? palette[[3L]](x),
??????????????????????????????????? if(alpha) palette[[4L]](x)),
????????????????????????????? from = space, to = "sRGB"))*255
? else
??? function(x)
????? roundcolor(cbind(palette[[1L]](x),
?????????????????????? palette[[2L]](x),
?????????????????????? palette[[3L]](x),
?????????????????????? if(alpha) palette[[4L]](x)))*255
}