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@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
