[Rd] arni.colors

[Arni Magnusson]

Dear r-devel,

I have implemented a function to create color palettes with improved
contrast and logical order, compared with the built-in ones:

 source("arni.colors.R")  # code is given below
 barplot(rep(1,100), col=arni.colors(100), space=0, border=0, axes=F)
 par(mfrow=c(2,1)) # rainbow() has too much green...
 barplot(rep(1,50), col=rev(rainbow(50,end=0.7)), space=0, border=0,
         axes=F)
 barplot(rep(1,50), col=arni.colors(50), space=0, border=0, axes=F)
 arni.colors(100, plot=T) # graph color recipes
 arni.colors(10, rgb=T)   # numeric color recipes

The arni.colors function also includes a palette="depth" which is an even
progression from dark blue to light blue. The color mixing proved to be
more complex than I anticipated:

 arni.colors(100, palette="depth", plot=T)

I'm hoping that the R Core Team can adopt these palettes, as is, as
separate functions, or as arguments to the already existing palette()
function. Of course I don't mind if the R Core Team changes the function
name or any other part of the code.

Thanks,
Arni



arni.colors <- function(n, palette=c("temperature", "depth"),
                        rgb.matrix=FALSE, plot.colors=FALSE)
{
  rgb2hsv <- function(v) rgb(v[1], v[2], v[3])
  palette <- match.arg(palette)
  x <- seq(0, 1, length=n)
  if(palette == "temperature") {
    r <- 1 / (1+exp(20-35*x))
    g <- pmin(pmax(0,-0.8+6*x-5*x^2), 1)
    b <- dnorm(x,0.25,0.15) / max(dnorm(x,0.25,0.15))
  }
  else {
    r <-        0.6*x + 0.4*x^2
    g <-        1.5*x - 0.5*x^2
    b <- 0.36 + 2.4*x - 2.0*x^2
    b[x>0.4] <- 1
  }
  rgb.m <- matrix(c(r,g,b), ncol=3,
                  dimnames=list(as.character(seq(length=n)),
                    c("red","green","blue")))
  hsv.v <- apply(rgb.m, 1, rgb2hsv)
  if(rgb.matrix)
    attr(hsv.v, "rgb.matrix") <- rgb.m
  if(plot.colors) {
    opar <- par("fig", "plt")
    par(fig=c(0,1,0,0.7), plt=c(0.15,0.9,0.2,0.95))
    plot(NA, xlim=c(-0.01,1.01), ylim=c(-0.01,1.01), xlab="Spectrum",
         ylab="", xaxs="i", yaxs="i", axes=FALSE)
    title(ylab="Value", mgp=c(3.5,0,0))
    matlines(x, rgb.m, col=colnames(rgb.m), lty=1, lwd=3)
    matpoints(x, rgb.m, col=colnames(rgb.m), pch=16)
    axis(1, at=0:1)
    axis(2, at=0:1, las=1)
    par(fig=c(0,1,0.75,0.9), plt=c(0.08,0.97,0,1), new=TRUE)
    midpoints <- barplot(rep(1,n), col=hsv.v, border=FALSE, space=FALSE,
                         axes=FALSE)
    axis(1, at=midpoints, labels=1:n, lty=0, cex.axis=0.6)
    par(opar)
  }
  return(hsv.v)
}