多种热图绘制方法
R 语言中可以用来绘制热图的包和函数：
# 1. 基础安装里的heatmap函数
heatmap(x, Rowv = NULL, Colv = if(symm)"Rowv" else NULL,
distfun = dist, hclustfun = hclust,
reorderfun = function(d, w) reorder(d, w),
add.expr, symm = FALSE, revC = identical(Colv, "Rowv"),
scale = c("row", "column", "none"), na.rm = TRUE,
margins = c(5, 5), ColSideColors, RowSideColors,
cexRow = 0.2 + 1/log10(nr), cexCol = 0.2 + 1/log10(nc),
labRow = NULL, labCol = NULL, main = NULL,
xlab = NULL, ylab = NULL,
keep.dendro = FALSE, verbose = getOption("verbose"), ...)
# 常用参数
# x 需要绘图的矩阵
# Rowv 决定“行层级聚类树图”是否以及如何被计算和重新排序，其默认值为空
# Colv 决定“列层级聚类树图”是否或如何被从排序。如果x是一个对称矩阵（行列数相同），那么 Colv=Rowv表示着列与行的处理方式相同。
# scale = c("row", "column", "none")，按照行或列进行归一化
# na.rm = TRUE 移除缺失值
# col 设置颜色，格式为向量
# pheatmap包里的pheatmap函数
install.packages(“pheatmap”) #安装pheatmap包
library(pheatmap) #加载pheatmap包
nba_heatmap <- pheatmap(nba_matrix,
cluster_rows = TRUE, cluster_cols = TRUE, # 设置行列是否聚类
col = heat.colors(100), scale="column")
# 相比于基础包中heatmap函数，pheatmap函数设置更为细致
# border_color = NA 设置格子灰色边框
# legend = TRUE 设置图例
# heatmap.plus包里面的heatmap.plus函数
# 与基础包中的heatmap类似，不同在于RowSideColors 和 ColSideColors参数，输入为矩阵
rc <- rainbow(nrow(nba_matrix), start = 0, end = .3)
cc <- rainbow(ncol(nba_matrix), start = 0, end = .3)
nba_heatmap <- heatmap(nba_matrix, Rowv=NA, Colv=NA,
col = heat.colors(100),
RowSideColors = rc,
ColSideColors = cc,scale="column")
# gplots 包里面的 heatmap.2 包
# 多出了“trace line”，默认表示中位数的转折点
heatmap.2(nba_matrix, Rowv=NA, Colv=NA, col = heat.colors(100), scale="column")
# d3heatmap 包中的 d3heatmap 函数
# d3heatmap、d3heatmapOutput、renderD3heatmap 均为交互式
d3heatmap(nba_matrix, Rowv=NA, Colv=NA,
col = heat.colors(100), scale="column")
# heatmaply包里面的heatmaply函数
heatmaply(nba_matrix, col = heat.colors(100),
fontsize_row=7, fontsize_col=7, scale="column", # 行标签字体大小、列标签字体大小
margins = c(50,120,NA,0)) # 边界（下、左、上、右）
# iheatmapr 包里的 iheatmap 函数
iheatmap(nba_matrix,colors = heat.colors(100), cluster_rows ="kmeans",
cluster_cols ="hclust",row_k=10,scale="cols")
# ComplexHeatmap 绘制热图
Heatmap(nba_matrix, cluster_rows = TRUE,
cluster_columns = TRUE,
col = heat.colors(100))
# Lattice包里面的 levelplot 函数
hc=hclust(dist(nba_matrix)) #按行聚类
dd.row=as.dendrogram(hc) #保存行聚类树形
row.ord=order.dendrogram(dd.row) #保存行聚类顺序
hc=hclust(dist(t(nba_matrix))) #按列聚类
dd.col=as.dendrogram(hc) #保存列聚类树形
col.rod=order.dendrogram(dd.col) #保存列聚类顺序
temp1=nba_matrix[row.ord,] #只对行聚类（是否对行、列聚类）
levelplot(t(temp1),aspect="fill",
colorkey=list(space="left",width=1.5),
xlab="",ylab="",
legend=list(right=list(fun=dendrogramGrob,
args=list(x=dd.row,rod=row.ord,side='right',
size=5)),
scales=list(x=list(rot=90))))
# ggplot2 包里面的 ggplot 函数绘制热图
nba.m <- melt(nba) #对数据进行融合
nba.m <- ddply(nba.m, .(variable), transform, rescale = rescale(value))
ggplot(nba.m, aes(variable, Name)) + geom_tile(aes(fill = rescale), colour = "white") + scale_fill_gradient(low = "white", high = "steelblue")
热图美化
数值标准化和调整坐标轴顺序
# 横轴旋转45度·
theme(axis.text.x=element_text(angle=45,hjust=1, vjust=1))
# 对数转换
# +1是为了防止对0取对数；是加1还是加个更小的值取决于数据的分布。
# 加的值一般认为是检测的低阈值，低于这个值的数字之间的差异可以忽略。
data_log <- log2(data+1)
# Z-score转换
# 一组数中的每个数减去这一组数的平均值再除以这一组数的标准差
# 代表的是原始分数距离原始平均值的距离，以标准差为单位
# 用来反映数据的相对变化趋势，而非绝对变化量
data <- data[apply(data,1,var)!=0,] # 去掉方差为0的行，也就是值全都一致的行
data_scale <- as.data.frame(t(apply(data,1,scale))) # 标准化数据，获得Z-score，并转换为data.frame
# 去掉异常值
data[data>100] <- 100 # 大于100的值都视为100对待
# 非线性颜色
# 对数据比较小但密集的地方赋予更多颜色，数据大但分布散的地方赋予更少颜色
# 可以选择用四分位数的方式设置颜色区间
summary_v <- summary(data_m$value) # 获取各分位数值
break_v <- unique(c(seq(summary_v[1]*0.95,summary_v[2],length=6),seq(summary_v[2],summary_v[3],length=6),seq(summary_v[3],summary_v[5],length=5),seq(summary_v[5],summary_v[6]*1.05,length=5))) # 分位数间划分区间
data_m$value <- cut(data_m$value, breaks=break_v,labels=break_v[2:length(break_v)]) # 分割数据
gradientC=c('green','yellow','red')
col <- colorRampPalette(gradientC)(length(break_v)) # 产生对应数目的颜色
p <- ggplot(data_m, aes(x=variable,y=ID)) + xlab("samples") + ylab(NULL) + theme_bw() + theme(panel.grid.major = element_blank()) + theme(legend.key=element_blank()) + theme(axis.text.x=element_text(angle=45,hjust=1, vjust=1)) + geom_tile(aes(fill=value))
p <- p + scale_fill_manual(values=col) # 颜色赋值
# 调整行和列
# 设置因子水平
data_log_m$ID <- factor(data_log_m$ID, levels=data_rownames, ordered=T)
p <- ggplot(data_log_m, aes(x=variable,y=ID)) + xlab(NULL) + ylab(NULL) + theme_bw() + theme(panel.grid.major = element_blank()) + theme(legend.key=element_blank()) + theme(axis.text.x=element_text(angle=45,hjust=1, vjust=1)) + theme(legend.position="top") + geom_tile(aes(fill=value)) + scale_fill_gradient(low = "white", high = "red")
# 聚类热图调整分支顺序
# 人为指定顺序排列样品
manual_order = c("Zygote", "2_cell", "4_cell", "8_cell", "Morula", "ICM")
dend = reorder(as.dendrogram(hclust_1), wts=order(match(manual_order, rownames(exprTable_t))))
col_cluster <- as.hclust(dend)
pheatmap(exprTable, cluster_cols = col_cluster)
# 按某个基因的表达由小到大排序
dend = reorder(as.dendrogram(hclust_1), wts=exprTable_t$Tet3)
col_cluster <- as.hclust(dend)
pheatmap(exprTable, cluster_cols = col_cluster)
# 按某个基因的表达由大到小排序
dend = reorder(as.dendrogram(hclust_1), wts=exprTable_t$Tet3*(-1))
col_cluster <- as.hclust(dend)
pheatmap(exprTable, cluster_cols = col_cluster)
# 按分支名字（样品名字）的字母顺序排序
library(dendextend)
col_cluster <- hclust_1 %>% as.dendrogram %>% sort %>% as.hclust
pheatmap(exprTable, cluster_cols = col_cluster)
# 梯子形排序：最小的分支在右侧
col_cluster <- hclust_1 %>% as.dendrogram %>% ladderize(TRUE) %>% as.hclust
pheatmap(exprTable, cluster_cols = col_cluster)
# 梯子形排序：最小的分支在左侧
col_cluster <- hclust_1 %>% as.dendrogram %>% ladderize(FALSE) %>% as.hclust
pheatmap(exprTable, cluster_cols = col_cluster)
# 按特征值排序（样本数多时使用）
sv = svd(exprTable)$v[,1]
dend = reorder(as.dendrogram(hclust_1), wts=sv)
col_cluster <- as.hclust(dend)
pheatmap(exprTable, cluster_cols = col_cluster)
