Do you mean something like:
http://cran.r-project.org/src/contrib/Descriptions/RColorBrewer.html
?
Andy
> From: Peter Kleiweg
>
>
> Anyone who is interested in using optimal colour palettes should
> look at the work of Cindy Brewer: www.colorbrewer.org
>
> I have written code to use her colour schemes in R. It is
> included below. Perhaps someone may find this interesting enough
> to work into a package.
>
> Included also is a function showpalette, which was posted here a
> while back. I don't remember who wrote it.
>
> I have copied all the palettes from colorbrewer with the maximum
> number of colours (which varies per palette). I have written a
> function that translates these colours directly to rgb, or
> through interpolation if you need a larger (or smaller) palette.
> If you need a smaller palette, you may have to go to
> www.colorbrewer.org for optimal results.
>
> There are three types of palettes:
> - Sequential, from minimal (light) to maximal (dark).
> There is no white in the original palettes. I added white.
> - Diverging, from one extreme (dark) through light to another
> extreme (dark, another colour).
> - Qualitative, no particular order.
>
> To view a palette with the original colours:
>
> > showpalette(brewer2rgb(brewerSequential.YlGnBl))
>
> To view the same palette, interpolated to another number of
> colours:
>
> > showpalette(brewer2rgb(brewerSequential.YlGnBl, 19))
>
> Notes:
>
> 1. Interpolating Qualitative palettes does not work. You can't
> get more colours. If you need less, go to www.colorbrewer.org
>
> 2. The palettes are tested to consist of colours that are
> optimally distinguishable to the human eye. Not all
> palettes may be useful in all circumstances or media. See
> www.colorbrewer.org for specs per palette and per number of
> colours. Interpolating to more colours will loose the
> distinction.
>
> The code:
>
> # www.colorbrewer.org
>
> brewerSequential.PuBu <- array(data = c(
> 255,255,255,
> 255,247,251,
> 236,231,242,
> 208,209,230,
> 166,189,219,
> 116,169,207,
> 54,144,192,
> 5,112,176,
> 4,90,141,
> 2,56,88),
> dim = c(3, 10))
>
> brewerSequential.YlGnBl <- array(data = c(
> 255,255,255,
> 255,255,217,
> 237,248,177,
> 199,233,180,
> 127,205,187,
> 65,182,196,
> 29,145,192,
> 34,94,168,
> 37,52,148,
> 8,29,88),
> dim = c(3, 10))
>
> brewerSequential.GnBu <- array(data = c(
> 255,255,255,
> 247,252,240,
> 224,243,219,
> 204,235,197,
> 168,221,181,
> 123,204,196,
> 78,179,211,
> 43,140,190,
> 8,104,172,
> 8,64,129),
> dim = c(3, 10))
>
> brewerSequential.YlGn <- array(data = c(
> 255,255,255,
> 255,255,229,
> 247,252,185,
> 217,240,163,
> 173,221,142,
> 120,198,121,
> 65,171,93,
> 35,132,67,
> 0,104,55,
> 0,69,41),
> dim = c(3, 10))
>
> brewerSequential.BuGn <- array(data = c(
> 255,255,255,
> 247,252,253,
> 229,245,249,
> 204,236,230,
> 153,216,201,
> 102,194,164,
> 65,174,118,
> 35,139,69,
> 0,109,44,
> 0,68,27),
> dim = c(3, 10))
>
> brewerSequential.OrRd <- array(data = c(
> 255,255,255,
> 255,247,236,
> 254,232,200,
> 253,212,158,
> 253,187,132,
> 252,141,89,
> 239,101,72,
> 215,48,31,
> 179,0,0,
> 127,0,0),
> dim = c(3, 10))
>
> brewerSequential.PuBuGn <- array(data = c(
> 255,255,255,
> 255,247,251,
> 236,226,240,
> 208,209,230,
> 166,189,219,
> 103,169,207,
> 54,144,192,
> 2,129,138,
> 1,108,89,
> 1,70,54),
> dim = c(3, 10))
>
> brewerSequential.BuPu <- array(data = c(
> 255,255,255,
> 247,252,253,
> 224,236,244,
> 191,211,230,
> 158,188,218,
> 140,150,198,
> 140,107,177,
> 136,65,157,
> 129,15,124,
> 77,0,75),
> dim = c(3, 10))
>
> brewerSequential.RdPu <- array(data = c(
> 255,255,255,
> 255,247,243,
> 253,224,221,
> 252,197,192,
> 250,159,181,
> 247,104,161,
> 221,52,151,
> 174,1,126,
> 122,1,119,
> 73,0,106),
> dim = c(3, 10))
>
> brewerSequential.PuRd <- array(data = c(
> 255,255,255,
> 247,244,249,
> 231,225,239,
> 212,185,218,
> 201,148,199,
> 223,101,176,
> 231,41,138,
> 206,18,86,
> 152,0,67,
> 103,0,31),
> dim = c(3, 10))
>
> brewerSequential.YlOrRd <- array(data = c(
> 255,255,255,
> 255,255,204,
> 255,237,160,
> 254,217,118,
> 254,178,76,
> 253,141,60,
> 252,78,42,
> 227,26,28,
> 189,0,38,
> 128,0,38),
> dim = c(3, 10))
>
> brewerSequential.YlOrBr <- array(data = c(
> 255,255,255,
> 255,255,229,
> 255,247,188,
> 254,227,145,
> 254,196,79,
> 254,153,41,
> 236,112,20,
> 204,76,2,
> 153,52,4,
> 102,37,6),
> dim = c(3, 10))
>
> brewerSequential.Purples <- array(data = c(
> 255,255,255,
> 252,251,253,
> 239,237,245,
> 218,218,235,
> 188,189,220,
> 158,154,200,
> 128,125,186,
> 106,81,163,
> 84,39,143,
> 63,0,125),
> dim = c(3, 10))
>
> brewerSequential.Blues <- array(data = c(
> 255,255,255,
> 247,251,255,
> 222,235,247,
> 198,219,239,
> 158,202,225,
> 107,174,214,
> 66,146,198,
> 33,113,181,
> 8,81,156,
> 8,48,107),
> dim = c(3, 10))
>
> brewerSequential.Greens <- array(data = c(
> 255,255,255,
> 247,252,245,
> 229,245,224,
> 199,233,192,
> 161,217,155,
> 116,196,118,
> 65,171,93,
> 35,139,69,
> 0,109,44,
> 0,68,27),
> dim = c(3, 10))
>
> brewerSequential.Oranges <- array(data = c(
> 255,255,255,
> 255,245,235,
> 254,230,206,
> 253,208,162,
> 253,174,107,
> 253,141,60,
> 241,105,19,
> 217,72,1,
> 166,54,3,
> 127,39,4),
> dim = c(3, 10))
>
> brewerSequential.Reds <- array(data = c(
> 255,255,255,
> 255,245,240,
> 254,224,210,
> 252,187,161,
> 252,146,114,
> 251,106,74,
> 239,59,44,
> 203,24,29,
> 165,15,21,
> 103,0,13),
> dim = c(3, 10))
>
> brewerSequential.Greys <- array(data = c(
> 255,255,255,
> 240,240,240,
> 217,217,217,
> 189,189,189,
> 150,150,150,
> 115,115,115,
> 82,82,82,
> 37,37,37,
> 0,0,0),
> dim = c(3, 9))
>
> brewerDiverging.PuOr <- array(data = c(
> 127,59,8,
> 179,88,6,
> 224,130,20,
> 253,184,99,
> 254,224,182,
> 247,247,247,
> 216,218,235,
> 178,171,210,
> 128,115,172,
> 84,39,136,
> 45,0,75),
> dim = c(3, 11))
>
> brewerDiverging.BrGr <- array(data = c(
> 84,48,5,
> 140,81,10,
> 191,129,45,
> 223,194,125,
> 246,232,195,
> 245,245,245,
> 199,234,229,
> 128,205,193,
> 53,151,143,
> 1,102,94,
> 0,60,48),
> dim = c(3, 11))
>
> brewerDiverging.PRGr <- array(data = c(
> 64,0,75,
> 118,42,131,
> 153,112,171,
> 194,165,207,
> 231,212,232,
> 247,247,247,
> 217,244,211,
> 168,216,183,
> 90,174,97,
> 27,120,55,
> 0,68,27),
> dim = c(3, 11))
>
> brewerDiverging.PiYG <- array(data = c(
> 142,1,82,
> 197,27,125,
> 222,119,174,
> 241,182,218,
> 253,224,239,
> 247,247,247,
> 230,245,208,
> 184,225,134,
> 127,188,65,
> 77,146,33,
> 39,100,25),
> dim = c(3, 11))
>
> brewerDiverging.RdBu <- array(data = c(
> 103,0,31,
> 178,24,43,
> 214,96,77,
> 244,165,130,
> 253,219,199,
> 247,247,247,
> 209,229,240,
> 146,197,222,
> 67,147,195,
> 33,102,172,
> 5,48,97),
> dim = c(3, 11))
>
> brewerDiverging.RdGy <- array(data = c(
> 103,0,31,
> 178,24,43,
> 214,96,77,
> 244,165,130,
> 253,219,199,
> 255,255,255,
> 224,224,224,
> 186,186,186,
> 135,135,135,
> 77,77,77,
> 26,26,26),
> dim = c(3, 11))
>
> brewerDiverging.RYB <- array(data = c(
> 165,0,38,
> 215,48,39,
> 244,109,67,
> 253,174,97,
> 254,224,144,
> 255,255,191,
> 224,243,248,
> 171,217,233,
> 116,173,209,
> 69,117,180,
> 49,54,149),
> dim = c(3, 11))
>
> brewerDiverging.spectral <- array(data = c(
> 158,1,66,
> 213,62,79,
> 244,109,67,
> 253,174,97,
> 254,224,139,
> 255,255,191,
> 230,245,152,
> 171,221,164,
> 102,194,165,
> 50,136,189,
> 94,79,162),
> dim = c(3, 11))
>
> brewerDiverging.RYG <- array(data = c(
> 165,0,38,
> 215,48,39,
> 244,109,67,
> 253,174,97,
> 254,224,139,
> 255,255,191,
> 217,239,139,
> 166,217,106,
> 102,189,99,
> 26,152,80,
> 0,104,55),
> dim = c(3, 11))
>
> brewerQualitative.Set3 <- array(data = c(
> 141,211,199,
> 255,255,179,
> 190,186,218,
> 251,128,114,
> 128,177,211,
> 253,180,98,
> 179,222,105,
> 252,205,229,
> 217,217,217,
> 188,128,189,
> 204,235,197,
> 255,237,111),
> dim = c(3, 12))
>
> brewerQualitative.Pastel1 <- array(data = c(
> 251,180,174,
> 179,205,227,
> 204,235,197,
> 222,203,228,
> 254,217,166,
> 255,255,204,
> 229,216,189,
> 253,218,236,
> 242,242,242),
> dim = c(3, 9))
>
> brewerQualitative.Set1 <- array(data = c(
> 228,26,28,
> 55,126,184,
> 77,175,74,
> 152,78,163,
> 255,127,0,
> 255,255,51,
> 166,86,40,
> 247,129,191,
> 153,153,153),
> dim = c(3, 9))
>
> brewerQualitative.Paired <- array(data = c(
> 166,206,227,
> 31,120,180,
> 178,223,138,
> 51,160,44,
> 251,154,153,
> 227,26,28,
> 253,191,111,
> 255,127,0,
> 202,178,214,
> 106,61,154,
> 255,255,153),
> dim = c(3, 11))
>
> brewerQualitative.Pastel2 <- array(data = c(
> 179,226,205,
> 253,205,172,
> 203,213,232,
> 244,202,228,
> 230,245,201,
> 255,242,174,
> 241,226,204,
> 204,204,204),
> dim = c(3, 8))
>
> brewerQualitative.Set2 <- array(data = c(
> 102,194,165,
> 252,141,98,
> 141,160,203,
> 231,138,195,
> 166,216,84,
> 255,217,47,
> 229,196,148,
> 179,179,179),
> dim = c(3, 8))
>
> brewerQualitative.Dark2 <- array(data = c(
> 27,158,119,
> 217,95,2,
> 117,112,179,
> 231,41,138,
> 102,166,30,
> 230,171,2,
> 166,118,29,
> 102,102,102),
> dim = c(3, 8))
>
> brewerQualitative.Accents <- array(data = c(
> 127,201,127,
> 190,174,212,
> 253,192,134,
> 255,255,153,
> 56,108,176,
> 240,2,127,
> 191,91,23,
> 102,102,102),
> dim = c(3, 8))
>
> brewer2rgb <- function(col, n = NA) {
> if (is.na(n)) {
> rgb(col[1, ] / 255, col[2, ] / 255, col[3, ] / 255)
> } else {
> seqin <- seq(0, 1, length = ncol(col))
> seqout <- seq(0, 1, length = n)
> r <- predict(smooth.spline(seqin, col[1, ] / 255), seqout)$y
> g <- predict(smooth.spline(seqin, col[2, ] / 255), seqout)$y
> b <- predict(smooth.spline(seqin, col[3, ] / 255), seqout)$y
> r[r < 0] <- 0 ; r[r > 1] <- 1
> g[g < 0] <- 0 ; g[g > 1] <- 1
> b[b < 0] <- 0 ; b[b > 1] <- 1
> rgb(r, g, b)
> }
> }
>
> brewerRemap1 <- function(col, n) {
> seqin <- seq(0, 1, length = ncol(col))
> seqout <- seq(0, 1, length = n)
> r <- predict(smooth.spline(seqin, col[1, ] / 255), seqout)$y
> g <- predict(smooth.spline(seqin, col[2, ] / 255), seqout)$y
> b <- predict(smooth.spline(seqin, col[3, ] / 255), seqout)$y
> r[r < 0] <- 0 ; r[r > 1] <- 1
> g[g < 0] <- 0 ; g[g > 1] <- 1
> b[b < 0] <- 0 ; b[b > 1] <- 1
> for (i in 1:n) {
> cat(r[i], g[i], b[i], "\n")
> }
> }
>
> brewerRemap255 <- function(col, n) {
> seqin <- seq(0, 255, length = ncol(col))
> seqout <- seq(0, 255, length = n)
> r <- as.integer(predict(smooth.spline(seqin, col[1, ]),
> seqout)$y + .5)
> g <- as.integer(predict(smooth.spline(seqin, col[2, ]),
> seqout)$y + .5)
> b <- as.integer(predict(smooth.spline(seqin, col[3, ]),
> seqout)$y + .5)
> r[r < 0] <- 0 ; r[r > 255] <- 255
> g[g < 0] <- 0 ; g[g > 255] <- 255
> b[b < 0] <- 0 ; b[b > 255] <- 255
> for (i in 1:n) {
> cat(r[i], g[i], b[i], "\n")
> }
> }
>
> showpalette <- function (palette) {
> n <- length(palette)
> rgb2hsv <- function(v) rgb(v[1], v[2], v[3])
> x <- seq(0, 1, length=n)
> rgb.m <- matrix(col2rgb(palette) / 255, ncol=3,, byrow=TRUE,
> dimnames=list(as.character(seq(length=n)),
> c("red","green","blue")))
> hsv.v <- apply(rgb.m, 1, rgb2hsv)
>
> 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)
> }
>
>
> --
> Peter Kleiweg
> http://www.let.rug.nl/~kleiweg/
>
> ______________________________________________
> R-devel@r-project.org mailing list
> https://stat.ethz.ch/mailman/listinfo/r-devel
>
>
>
______________________________________________
R-devel@r-project.org mailing list
https://stat.ethz.ch/mailman/listinfo/r-devel
