R devel - Jul 2013 - Alpha channel in colorRamp() and colorRampPalette()

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

Thank you for the suggestion. But editing deparsed code is of almost no 
use to us: you need to edit the sources.  And even then mailers may 
distort it, so it really is much easier to file these things as 
attachments on bugs.r-project.org, as a wishlist item.

I have incorporated what I think you intended in R-devel, so please test it.

On 24/07/2013 16:00, Alberto Krone-Martins wrote:
>
>   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
>
>
>
>
>
> ______________________________________________
> R-devel at r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>

-- 
Brian D. Ripley,                  ripley at stats.ox.ac.uk
Professor of Applied Statistics,  http://www.stats.ox.ac.uk/~ripley/
University of Oxford,             Tel:  +44 1865 272861 (self)
1 South Parks Road,                     +44 1865 272866 (PA)
Oxford OX1 3TG, UK                Fax:  +44 1865 272595