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/
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 > > >
Liaw, Andy schreef op de 7e dag van de hooimaand van het jaar 2005:> Do you mean something like: > http://cran.r-project.org/src/contrib/Descriptions/RColorBrewer.html > ?Now I feel silly. Well, it was a nice exercise. -- Peter Kleiweg http://www.let.rug.nl/~kleiweg/
Apparently Analagous Threads
- 账户登陆地异常调整通知
- [Openmp-dev] [cfe-dev] RFC: Proposing an LLVM subproject for parallelism runtime and support libraries
- [Openmp-dev] [cfe-dev] RFC: Proposing an LLVM subproject for parallelism runtime and support libraries
- Ruby Developer position
- Linking Linux kernel with LLD