[Rd] Brewer colours
Peter Kleiweg
pkleiweg at xs4all.nl
Thu Jul 7 16:32:50 CEST 2005
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/
More information about the R-devel
mailing list