From andy_liaw at merck.com  Thu Jul  7 16:38:44 2005
From: andy_liaw at merck.com (Liaw, Andy)
Date: Thu, 7 Jul 2005 10:38:44 -0400
Subject: [Rd] Brewer colours
Message-ID: <39B6DDB9048D0F4DAD42CB26AAFF0AFA64EA73@usctmx1106.Merck.com>

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



[Rd] Brewer colours
Liaw, Andy