public
Last active

R code for blog post on R colours

  • Download Gist
colours.r
R
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160
library(gridExtra)
library(RColorBrewer)
 
pal1 <- 1:7
pal2 <- brewer.pal(7, "Set1")
pal3 <- brewer.pal(7, "Pastel1")
pal4 <- brewer.pal(7, "PRGn")
 
 
colorstrip <- function(x){
rasterGrob(x, width=unit(1,"npc"), height = unit(1,"npc"), interpolate=FALSE)
}
 
require(gtable)
 
colorStrips <- function(m, labels){
 
strips <- lapply(m, colorstrip)
## browser()
labels <- lapply(labels, textGrob,hjust=1,x=1,gp=gpar(fontface="italic"))
w <- lapply(labels, grobWidth)
h <- lapply(labels, grobHeight)
mat <- matrix(strips, nrow=nrow(m))
 
gc <-
gtable_matrix("demo", mat, heights=unit(rep(2,nrow(m)), "lines"),
widths=unit(rep(1, ncol(m)), "null"))
tg <- gtable_matrix("text", matrix(labels, nrow=nrow(m)),
heights=do.call(unit.c, h),
widths=max(do.call(unit.c,w)))
gt <- cbind(tg,gc,size = "last")
gt <- gtable_add_col_space(gt, unit(0.5,"mm"))
gt <- gtable_add_row_space(gt, unit(1,"mm"))
gt
 
}
 
png("overview.png", width=6, height=2, unit="in", res=300)
m <- rbind(pal1,pal2,pal3,pal4)
labs <- c("base palette", "RColorBrewer Set1", "RColorBrewer Pastel1", "RColorBrewer PRGn")
g <- colorStrips(m, labs)
grid.draw(g)
dev.off()
 
 
png("base.png", width=6, height=5, unit="in", res=300)
fun <- list(rainbow, heat.colors, terrain.colors, cm.colors, topo.colors)
 
base <-
cbind(palette(), blues9[1:8], sapply(fun, function(f, n) f(n), n=8), gray(seq(0,1,length=8)), colors()[1:8] , hcl(seq(0,360,length=8)), hsv(seq(0,1,length=8)) )
nm <- c("palette","blues9", "rainbow", "heat.colors", "terrain.colors",
"cm.colors", "topo.colors", "gray", "colors", "hcl", "hsv")
o <- c(9, 1, 3, 8, 11, 2, 4, 5, 6, 7, 10)
g <- colorStrips(t(base[,o]), nm[o])
grid.draw(g)
 
dev.off()
 
 
 
png("brewer-div.png", width=6, height=4, unit="in", res=300)
m <- subset(brewer.pal.info, category == "div")
brewer <- sapply(rownames(m), function(x) brewer.pal(8, x))
g <- colorStrips(t(brewer), rownames(m))
grid.draw(g)
dev.off()
 
png("brewer-seq.png", width=6, height=7, unit="in", res=300)
m <- subset(brewer.pal.info, category == "seq")
brewer <- sapply(rownames(m), function(x) brewer.pal(8, x))
g <- colorStrips(t(brewer), rownames(m))
grid.draw(g)
dev.off()
 
png("brewer-qual.png", width=6, height=3.5, unit="in", res=300)
m <- subset(brewer.pal.info, category == "qual")
brewer <- sapply(rownames(m), function(x) brewer.pal(8, x))
g <- colorStrips(t(brewer), rownames(m))
grid.draw(g)
dev.off()
 
 
library(ggplot2)
library(reshape2)
 
 
 
p1 <- ggplot(mtcars, aes(wt, mpg, colour = qsec)) + geom_point() +
opts(legend.position="top",title="p1")+ guides(colour=guide_legend(title.position="top"))
p2 <- qplot(factor(cyl), data=mtcars, geom="bar", fill=factor(cyl)) +
opts(legend.position="top",title="p2")+ guides(fill=guide_legend(title.position="top"))
p3 <- ggplot(melt(volcano), aes(x=Var1, y=Var2, fill=value)) + geom_tile() +
opts(legend.position="top",title="p3") + guides(fill=guide_colourbar(title.position="top"))
 
library(gridExtra)
png("ggplot.png", width=6, height=3.5, unit="in", res=300)
grid.arrange(p1,p2,p3,nrow=1)
dev.off()
 
 
 
d = data.frame(x = 1:10, y = rnorm(10), z = gl(5, 2))
a = ggplot(d, aes(x, y, group=z))
png("mapping.png", width=6, height=3, unit="in", res=300)
grid.arrange(a + geom_path( colour = "red" ), a + geom_path( aes(colour = z )), nrow=1)
dev.off()
 
 
 
png("continuous.png", width=6, height=0.5, unit="in", res=300)
cols <- scales::seq_gradient_pal(low = "#132B43", high = "#56B1F7", space = "Lab")(seq(0,1, length=8))
g <- colorStrips(t(cols), "")
grid.draw(g)
dev.off()
 
 
png("discrete.png", width=6, height=0.5, unit="in", res=300)
cols <- scales::hue_pal(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1)(8)
g <- colorStrips(t(cols), "")
grid.draw(g)
dev.off()
 
 
c1 <- scales::seq_gradient_pal(low = "#132B43", high = "#56B1F7", space = "Lab")(seq(0,1, length=8))
c2 <- scales::hue_pal(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1)(8)
c3 <- scales::gradient_n_pal(terrain.colors(8))(seq(0,1,length=8))
c4 <- scales::grey_pal(0, 1)(8)
c5 <- brewer.pal(8, "Set1")
png("ggplot-defaults.png", width=6, height=0.5*5, unit="in", res=300)
cols <- cbind(c1,c4,c2,c3,c5)
g <- colorStrips(t(cols), c("gradient", "grey","hue","gradientn\n(terrain.colors)","brewer\n(Set1)"))
grid.draw(g)
dev.off()
setwd("/Users/baptiste/Dropbox/blog/")
 
library(grid)
library(matlab)
c <- jet.colors(200)
 
png("matlab.png", width=6, height=convertUnit(unit(2,"lines"),"in",value=TRUE), unit="in", res=300)
grid.raster(t(c), height=unit(2,"lines"),width=unit(1,"npc"))
dev.off()
 
c1 <- scales::hue_pal(h = c(0, 360) + 15, c = 100, l = 65, h.start = 0,
direction = 1)(8)
c2 <- scales::hue_pal(h = c(0, 360) + 15, c = 50, l = 65, h.start = 0,
direction = 1)(8)
c3 <- scales::hue_pal(h = c(0, 360) + 15, c = 50, l =85, h.start = 0,
direction = 1)(8)
 
png("ggplot-mutedhcl.png", width=6, height=0.5*3, unit="in", res=300)
cols <- cbind(c1,c2,c3)
g <- colorStrips(t(cols), c("c=100, l=65\n(default)", "c=50, l=65","c=50, l=85"))
grid.draw(g)
dev.off()

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.