[Rd] Alpha channel in colorRamp() and colorRampPalette()

Alberto Krone-Martins algol at sim.ul.pt
Wed Jul 24 17:00:15 CEST 2013


 
 Hi all, 

 I had the need to create a colorbar considering the alpha channel of the colors, but colorRamp() and colorRampPalette() ignored the alpha argument in rgb(). So I performed some minor modifs. in their codes, as to support the interpolation using the alpha channel.
 
 I guess that those simple modifications might be useful for other people, so perhaps it would be worth to add them to colorRamp and colorRampPalette codes in grDevices… the modified functions follows.
 
 Cheers,
 
 Alberto.
 
colorRampPalette <- function (colors, ...) {
    ramp <- colorRamp(colors, ...)
    function(n) {
        x <- ramp(seq.int(0, 1, length.out = n))
        rgb(x[, 1], x[, 2], x[, 3], x[, 4], maxColorValue = 255)
    }
}

colorRamp <- function (colors, bias = 1, space = c("rgb", "Lab"), interpolate = c("linear", "spline")) {
    if (bias <= 0) 
        stop("'bias' must be positive")
    colors <- t(col2rgb(colors, alpha=T)/255)
    space <- match.arg(space)
    interpolate <- match.arg(interpolate)
    if (space == "Lab") {
        colors <- convertColor(colors, from = "sRGB", to = "Lab")
    }
    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[, 1]), interpolate(x, colors[, 2]), interpolate(x, colors[, 3]), interpolate(x, colors[, 4]))
    roundcolor <- function(rgb) pmax(pmin(rgb, 1), 0)
    if (space == "Lab") {
        function(x) {
            roundcolor(convertColor(cbind(palette[[1L]](x), palette[[2L]](x), 
                palette[[3L]](x), palette[[4L]](x)), from = "Lab", to = "sRGB")) * 
                255
        }
    }
    else {
        function(x) {
            roundcolor(cbind(palette[[1L]](x), palette[[2L]](x), 
                palette[[3L]](x), palette[[4L]](x))) * 255
        }
    }
}

____________________________________________________

 Universidade de Lisboa - Laboratório SIM
 Alberto Krone-Martins
 http://www.astro.iag.usp.br/~algol







More information about the R-devel mailing list