1 カラーパレット

par(mfrow=c(2,3), mar=c(1,1,3,1))
barplot(rep(1,8), col=palette(), main="palette()", axes=F) # palette()で色名を呼び出す。
#barplot(rep(1,8), col=c(1:8), main="1:8",axes=F) # 数値でも指定できる。

barplot(rep(1,12), col=heat.colors(12), main = "heat.colors", axes=F) 
barplot(rep(1,12), col=topo.colors(12), main = "topo.colors", axes=F) 
barplot(rep(1,12), col=cm.colors(12), main = "cm.colors", axes=F) 
barplot(rep(1,12), col=rainbow(12), main = "rainbow", axes=F) 
barplot(rep(1,12), col=terrain.colors(12), main = "terrain.colors",axes=F)

2 色名colors

pacman::p_load("dplyr", "tidyr", "ggplot2")

# データ 
  d <- data.frame(matrix(c(1:length(colors()), rep(NA,3)), nrow=60)) %>%
    setNames(., 1:ncol(.)) %>%
    tibble::rownames_to_column("Row") %>%
    tidyr::gather(., key = k, value = v, -Row) %>%
    dplyr::mutate(Row = factor(Row, levels = 60:1),
                  k = factor(k, levels = 1:11),
                  v = factor(v)) 

# テキストの色を見やすいように変える 
  cex.cols <- ifelse(1:660 %in% c(grep("dark",colors()), 24,61,153:199,260:309,477,490,491), "white", "black")

# ggplot 
ggcols <- ggplot2::ggplot(d, ggplot2::aes(k, Row)) +
    ggplot2::geom_tile(ggplot2::aes(fill = v), colour="white") +
    ggplot2::scale_fill_manual(values = colors()) +
    ggplot2::theme(legend.position="none") +
    ggplot2::labs(x = "", y ="") +
    ggplot2::geom_text(ggplot2::aes(label= paste0(1:660, ":",c(colors(), rep("",3)))),
                       col=factor(cex.cols), size=1.8)
print(ggcols)

3 Rcolorbrewer

library(RColorBrewer)
 
# palette, colorblindFriendly
display.brewer.all(colorblindFriendly=TRUE)

# color vector 
col1 <- brewer.pal(3, "Set2")[iris$Species]
col2 <- brewer.pal(3, "Dark2")[iris$Species]

# plot 
par(mfrow=c(1,2))
plot(iris[,1:2], col=col1, pch=20)
plot(iris[,1:2], col=col2, pch=20)

4 数値の大小と色を対応させたベクトル作成

4.1 gplots, colorRampPalette

  • gplots::colorpanel(n, low, mid, high)
  • colorRampPalette(colors)
# gplots
gr250 <- gplots::greenred(256)
br250 <- gplots::bluered(256)
cm250 <- gplots::colorpanel(n = 256, low = "deepskyblue", mid = "white", high = "violetred")

# colorRampPalette
pal1_fun <- colorRampPalette(c("green", "white", "red"))
pal2_fun <- colorRampPalette(c("dark blue", "purple", "white", "orange","dark red"))


# plot
par(mfrow = c(2,3))
barplot(rep(1,256), col=br250, border = br250, axes=F)
barplot(rep(1,256), col=gr250, border = gr250, axes=F)
barplot(rep(1,256), col=cm250, border = cm250, axes=F)
barplot(rep(1,256), col=pal1_fun(256), border = pal1_fun(256), axes=F)
barplot(rep(1,256), col=pal2_fun(256), border = pal2_fun(256), axes=F)

# color code corresponding to numeric value
x <- runif(1000, max = 1, min = -1)
ord_col <- pal2_fun(length(x))[order(order(x))]
plot(x, col=ord_col, pch =20)

4.2 tagcloud::smoothPalette 数値の大小と対応したカラーコードを作成する

library(tagcloud)

# data
set.seed(123)
x <- runif(n = 1000, min = 0, max = 100)

# color code
col3  <- smoothPalette(x, pal="Blues")
 
# plot 
plot(x, col = col3, pch=16)

4.3 離散値化して区間ごとに割り振るcut

  • cut離散値化してfactorが返る
  • labelsにカラーコードを指定してas.characterすれば対応するカラーコードのベクトルが得られる. cut(x, breaks, labels)
  • 区間に対応するカラーコードの添え字にfactorを与えて作るのでも良い.
  • include.lowest 最小（もし right = F なら最大）の分割点値に一致する `x[i]’ を含めるかどうか
  • right 区間が右に閉じている（そして左に開いている）か否か(デフォルトでTRUE)
# data 
set.seed(123) 
x <- runif(n = 1000, min = 0, max = 100)

# break
br1 <- c(0,20,40,60,80,100)　# 分割点 
br2 <- quantile(x) # クォンタイル点で分割

# color code
x.cols1 <- as.character(cut(x, breaks=br1, labels=brewer.pal(5, "Blues"), include.lowest=F))
x.cols2 <- as.character(cut(x, breaks=br2, labels=brewer.pal(4, "Reds"), include.lowest=F))
# x.cols1 <- RColorBrewer::brewer.pal(5, "Blues")[cut(x, breaks=br1, include.lowest=F)] # これでも良い

# plot
par(mfrow =c(1,2))
plot(x, col = as.character(x.cols1), pch =16, main = "divide at specified value")
plot(x, col = as.character(x.cols2), pch =16, main = "divide at quantile")

4.4 離散値化して区間ごとに割り振るfindInterval

  • 離散値化してintegerが返る
# value　
scx <- scale(x)

# break point
br3 <- c(min(scx), -1, 0, 1, max(scx))

# findInterval
int <- findInterval(scx, br3, rightmost.closed = T, all.inside = T)

# color code
x.cols3 <- rev(brewer.pal(4, "RdYlBu"))[ int ]

# plot
plot(scx, col = x.cols3, pch =16)

4.5 squashパッケージを使う場合

  • makecmap カラーマップを作る. デフォルトでprettyを使って区分けしている
# color palette of squash package
library(squash)
squash.palettes <- c('rainbow2', 'jet', 'grayscale', 'heat', 'coolheat', 'blueorange', 'bluered', 'darkbluered')
 
par(mfrow=c(3,3), mar=c(1,1,3,1))
invisible(
  lapply(squash.palettes, 
       function(p){
         sq <- makecmap(c(0, 9), colFn = get(p))$colors
         barplot(rep(1,10), axes=F, col=sq, main=p)
         }
       )
)

  • cmap makecmapで作成したカラーマップを適応したカラーコード
  • hkey,vkey カラーキーを図に追加する
x <- runif(1000, 0, 100)
map1 <- makecmap(x, colFn = get("darkbluered")) # デフォルトでprettyを使って区分けしている
col1 <- cmap(x, map = map1)

par(mar = c(6,4,4,3))
plot(x, col = col1, pch = 16)
hkey(map1, title = 'x')
vkey(map1, title = 'x')

5 透過色の作成 adjustcolor

adjcols <- adjustcolor(c("red", "blue", "green"), alpha.f = 0.2)

# plotテスト
set.seed(1)
norm1 <- rnorm(1000, mean = 30, sd = 10)
norm2 <- rnorm(1000, mean = 60, sd = 10)
norm3 <- rnorm(1000, mean = 90, sd = 10)

par(mfrow=c(1,2))
lim <- range(norm1, norm2, norm3)
hist(norm1, border="transparent", breaks=50, xlab="norm", xlim = lim, col = adjcols[1])
hist(norm2, border="transparent", breaks=50, xlab=F, xlim = lim, col = adjcols[2], add=T)
hist(norm3, border="transparent", breaks=50, xlab=F, xlim = lim, col = adjcols[3], add=T)

plot(norm1, col=adjcols[1], pch=16, ylim = lim, ylab="norm"); par(new=T)
plot(norm2, col=adjcols[2], pch=16, axes = F, xlab=NA, ylab=NA); par(new=T)
plot(norm3, col=adjcols[3], pch=16, axes = F, xlab=NA, ylab=NA)

6 環境

sessionInfo()
## R version 3.5.1 (2018-07-02)
## Platform: x86_64-apple-darwin15.6.0 (64-bit)
## Running under: macOS Sierra 10.12.6
## 
## Matrix products: default
## BLAS: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRblas.0.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/3.5/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] ja_JP.UTF-8/ja_JP.UTF-8/ja_JP.UTF-8/C/ja_JP.UTF-8/ja_JP.UTF-8
## 
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base     
## 
## other attached packages:
## [1] squash_1.0.8       tagcloud_0.6       Rcpp_1.0.0        
## [4] RColorBrewer_1.1-2 bindrcpp_0.2.2     ggplot2_3.1.0     
## [7] tidyr_0.8.2        dplyr_0.7.8       
## 
## loaded via a namespace (and not attached):
##  [1] pillar_1.3.0       compiler_3.5.1     plyr_1.8.4        
##  [4] bindr_0.1.1        bitops_1.0-6       tools_3.5.1       
##  [7] digest_0.6.18      evaluate_0.12      tibble_1.4.2      
## [10] gtable_0.2.0       pkgconfig_2.0.2    rlang_0.3.0.1     
## [13] yaml_2.2.0         withr_2.1.2        stringr_1.3.1     
## [16] knitr_1.20         caTools_1.17.1.1   gtools_3.8.1      
## [19] rprojroot_1.3-2    grid_3.5.1         tidyselect_0.2.5  
## [22] glue_1.3.0         R6_2.3.0           rmarkdown_1.10    
## [25] pacman_0.5.0       gdata_2.18.0       purrr_0.2.5       
## [28] magrittr_1.5       backports_1.1.2    scales_1.0.0      
## [31] gplots_3.0.1       htmltools_0.3.6    assertthat_0.2.0  
## [34] colorspace_1.3-2   KernSmooth_2.23-15 stringi_1.2.4     
## [37] lazyeval_0.2.1     munsell_0.5.0      crayon_1.3.4