This browser does not support music or audio playback. Please play it in WeChat or another browser.

14. 热图绘制

清除当前环境中的变量

rm(list=ls())

设置工作目录

setwd("C:/Users/Dell/Desktop/R_Plots/14heatmap/")

使用heatmap函数绘制热图

# 使用mtcars内置数据集
x  <- as.matrix(mtcars)
head(x)
##                    mpg cyl disp  hp drat    wt  qsec vs am gear carb
## Mazda RX4         21.0   6  160 110 3.90 2.620 16.46  0  1    4    4
## Mazda RX4 Wag     21.0   6  160 110 3.90 2.875 17.02  0  1    4    4
## Datsun 710        22.8   4  108  93 3.85 2.320 18.61  1  1    4    1
## Hornet 4 Drive    21.4   6  258 110 3.08 3.215 19.44  1  0    3    1
## Hornet Sportabout 18.7   8  360 175 3.15 3.440 17.02  0  0    3    2
## Valiant           18.1   6  225 105 2.76 3.460 20.22  1  0    3    1

# 设置行的颜色
rc <- rainbow(nrow(x), start = 0, end = .3)
# 设置列的颜色
cc <- rainbow(ncol(x), start = 0, end = .3)
head(rc)
## [1] "#FF0000FF" "#FF0F00FF" "#FF1E00FF" "#FF2C00FF" "#FF3B00FF" "#FF4A00FF"

head(cc)
## [1] "#FF0000FF" "#FF2E00FF" "#FF5C00FF" "#FF8A00FF" "#FFB800FF" "#FFE500FF"

heatmap(x, #表达矩阵
        col = cm.colors(256), #设置热图颜色
        scale = "column", #对列进行归一化
        RowSideColors = rc, #设置行的颜色
        ColSideColors = cc, #设置列的颜色
        margins = c(5,10),
        xlab = "specification variables", #x轴标题
        ylab =  "Car Models", #y轴标题
        main = "heatmap(<Mtcars data>, ..., scale = \"column\")" #主标题
        )

heatmap(x, #表达矩阵
        col = topo.colors(16), #设置热图颜色
        scale = "column", #对列进行归一化
        Colv = NA, #不对列聚类
        RowSideColors = rc, #设置行的颜色
        ColSideColors = cc, #设置列的颜色
        margins = c(5,10),
        cexRow = 1.2, #设置行名字体大小
        cexCol = 1.5, #设置列名字体大小
        xlab = "specification variables", #x轴标题
        ylab =  "Car Models" #y轴标题
)

使用gplots包中的heatmap.2函数绘制热图

library(gplots)
x  <- as.matrix(mtcars)
rc <- rainbow(nrow(x), start=0, end=.3)
cc <- rainbow(ncol(x), start=0, end=.3)

heatmap.2(x, scale="col",
          col=redgreen,
          RowSideColors=rc,
          ColSideColors=cc,
          margin=c(5, 10),
          key=TRUE, # 添加color key
          cexRow = 1.0,
          cexCol = 1.2)

heatmap.2(x, scale="col",
          col=terrain.colors(256),
          RowSideColors=rc,
          ColSideColors=cc,
          margin=c(5, 10),
          colsep = c(7,9), #对列添加分割线
          rowsep = c(16,23), #对行添加分割线
          sepcolor = "white", #设置分割线的颜色
          xlab="specification variables",
          ylab= "Car Models",
          main="heatmap(<Mtcars data>, ..., scale=\"column\")",
          density.info="density", # color key density info
          trace="none" # level trace
          )

使用ggplot2包绘热图

library(ggplot2)

# 构建测试数据集
x <- LETTERS[1:20]
y <- paste0("var", seq(1,20))
data <- expand.grid(X=x, Y=y)
data$Z <- runif(400, 0, 5)
head(data)
##   X    Y         Z
## 1 A var1 3.3976881
## 2 B var1 4.8360453
## 3 C var1 1.6429939
## 4 D var1 2.9155628
## 5 E var1 1.8528057
## 6 F var1 0.1852349

# 使用geom_tile()函数绘制热图
ggplot(data, aes(X, Y, fill= Z)) +
        geom_tile()

# 更换填充颜色
# Give extreme colors:
ggplot(data, aes(X, Y, fill= Z)) +
        geom_tile() +
        scale_fill_gradient(low="white", high="blue") +
        theme_bw() #设置主题

# Color Brewer palette
ggplot(data, aes(X, Y, fill= Z)) +
        geom_tile() +
        scale_fill_distiller(palette = "RdPu") +
        theme_classic()

# Color Brewer palette
library(viridis)
ggplot(data, aes(X, Y, fill= Z)) +
        geom_tile() +
        scale_fill_viridis(discrete=FALSE) +
        theme_minimal() + theme(legend.position = "top")

使用lattice包中的levelplot函数绘制热图

library(lattice)

# 构建测试数据集
data <- matrix(runif(100, 0, 5) , 10 , 10)
colnames(data) <- letters[c(1:10)]
rownames(data) <- paste( rep("row",10) , c(1:10) , sep=" ")
head(data)
##               a        b          c        d         e        f        g
## row 1 0.1057270 1.126285 3.54298505 2.865719 1.2383436 3.010582 4.591185
## row 2 1.7243532 2.338656 3.39013752 3.828583 0.7724234 2.159923 3.172657
## row 3 2.6278888 1.201316 3.57443791 1.766179 2.8245389 3.426238 3.780099
## row 4 0.7842127 3.122185 0.04581288 4.603754 2.6170560 2.591225 1.484314
## row 5 0.6968536 4.710725 4.61106397 3.595087 3.6042751 1.675838 4.791346
## row 6 2.3674860 1.586397 4.96365588 2.506186 1.9199281 4.712907 2.638063
##               h         i          j
## row 1 4.4767551 1.9802395 0.09680932
## row 2 0.7798872 0.3209790 1.33545824
## row 3 0.1705967 0.4696357 2.60913663
## row 4 1.0787051 1.6417671 2.30342064
## row 5 2.9486102 0.5454374 0.79169282
## row 6 1.8602256 1.2668269 2.76660363

levelplot(data)

# 更换颜色
levelplot(t(data),cuts=30,
          col.regions=heat.colors(100),
          xlab = "",ylab = "",colorkey = list(space="top",width=2))

# 查看内置数据集
volcano[1:5,1:5]
##      [,1] [,2] [,3] [,4] [,5]
## [1,]  100  100  101  101  101
## [2,]  101  101  102  102  102
## [3,]  102  102  103  103  103
## [4,]  103  103  104  104  104
## [5,]  104  104  105  105  105

# try cm.colors() or terrain.colors()
levelplot(volcano, col.regions = terrain.colors(100))

# 使用RColorBrewer包中的配色
library(RColorBrewer)
coul <- colorRampPalette(brewer.pal(8, "PiYG"))(25)
levelplot(volcano, col.regions = coul)

# 使用viridisLite包中的配色
library(viridisLite)
coul <- viridis(100)
levelplot(volcano, col.regions = coul)

sessionInfo()
## R version 3.6.0 (2019-04-26)
## Platform: x86_64-w64-mingw32/x64 (64-bit)
## Running under: Windows 10 x64 (build 18363)
##
## Matrix products: default
##
## locale:
## [1] LC_COLLATE=Chinese (Simplified)_China.936
## [2] LC_CTYPE=Chinese (Simplified)_China.936
## [3] LC_MONETARY=Chinese (Simplified)_China.936
## [4] LC_NUMERIC=C
## [5] LC_TIME=Chinese (Simplified)_China.936
##
## attached base packages:
## [1] stats     graphics  grDevices utils     datasets  methods   base
##
## other attached packages:
## [1] RColorBrewer_1.1-2 lattice_0.20-38    viridis_0.5.1
## [4] viridisLite_0.3.0  ggplot2_3.2.0      gplots_3.0.1.1
##
## loaded via a namespace (and not attached):
##  [1] Rcpp_1.0.5         compiler_3.6.0     pillar_1.4.2
##  [4] bitops_1.0-6       tools_3.6.0        digest_0.6.20
##  [7] evaluate_0.14      tibble_2.1.3       gtable_0.3.0
## [10] pkgconfig_2.0.2    rlang_0.4.7        yaml_2.2.0
## [13] xfun_0.8           gridExtra_2.3      withr_2.1.2
## [16] stringr_1.4.0      dplyr_0.8.3        knitr_1.23
## [19] gtools_3.8.1       caTools_1.17.1.2   grid_3.6.0
## [22] tidyselect_0.2.5   glue_1.3.1         R6_2.4.0
## [25] rmarkdown_1.13     gdata_2.18.0       purrr_0.3.2
## [28] magrittr_1.5       scales_1.0.0       htmltools_0.3.6
## [31] assertthat_0.2.1   colorspace_1.4-1   labeling_0.3
## [34] KernSmooth_2.23-15 stringi_1.4.3      lazyeval_0.2.2
## [37] munsell_0.5.0      crayon_1.3.4