绘图代码|10种绘制热图方法，你想要的全都有！

library(ggplot2)
####建立模拟数据集
set.seed(123)
Year <- rep(2006:2015, each = 4)
Quater <- rep(c('Q1','Q2','Q3','Q4'), times = 10)
Counts <- round(runif(40, min = 10, max = 200))
df <- data.frame(Year = Year, Quater = Quater, Counts = Counts)
fix(df)

ggplot(data = df, mapping = aes(x = factor(Year),y = Quater, fill = Counts)) +
  geom_tile() +
  scale_fill_continuous(low = 'white', high = 'OrangeRed') +
  scale_y_discrete(limits=c('Q4','Q3','Q2','Q1')) +
  xlab('Year')

# 测试数据
a=c(12,14,17,11,16)
b=c(4,20,15,11,9)
c=c(5,7,19,8,18)
d=c(15,13,11,17,16)
e=c(12,19,16,7,9)
A=cbind(a,b,c,d,e)
require(graphics)
require(grDevices)
x  <- as.matrix(A)
rc <- rainbow(nrow(x), start = 0, end = .3)
cc <- rainbow(ncol(x), start = 0, end = .3)
hv <- heatmap(x, col = cm.colors(256), scale = "column",
              RowSideColors = rc, ColSideColors = cc, margins = c(5,10),
              xlab = "specification variables", ylab =  "Car Models")

mat <- matrix(rnorm(1200), ncol=6)
heatmap.2(x=mat)

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

heatmap.2(x)

heatmap.2(x, Colv=full$colDendrogram[[2]],
          Rowv=full$rowDendrogram[[1]],
          #然后根据向量的顺序计算树状图并重新排序
          breaks=full$breaks )
          #将x分割成不同颜色的分界点

heatmap.2(x, srtRow=45,
          #标签从水平开始转动的角度
          adjRow=c(0, 1),
          #提供行/列标签(从左到右，从上到下)对齐的2个元素向量
          srtCol=45,
          adjCol=c(1,1)
          )

library(pheatmap)
###构建示例数据
test = matrix(rnorm(200), 20, 10)
test[1:10, seq(1, 10, 2)] = test[1:10, seq(1, 10, 2)] + 3
test[11:20, seq(2, 10, 2)] = test[11:20, seq(2, 10, 2)] + 2
test[15:20, seq(2, 10, 2)] = test[15:20, seq(2, 10, 2)] + 4
colnames(test) = paste("Test", 1:10, sep = "")
rownames(test) = paste("Gene", 1:20, sep = "")
head(test)

####构建行注释信息
annotation_row = data.frame(
  GeneClass = factor(rep(c("Path1", "Path2", "Path3"), c(10, 4, 6)))
)
rownames(annotation_row) = paste("Gene", 1:20, sep = "")
head(annotation_row)

####构建列注释信息
annotation_col = data.frame(
  CellType = factor(rep(c("CT1", "CT2"), 5)),
  Time = 1:5
)
rownames(annotation_col) = paste("Test", 1:10, sep = "")
head(annotation_col)

pheatmap(test,
         scale = "row",#对行进行归一化
         clustering_method = "average",#选择聚类方法
         legend_breaks = c(1:5),
         #设定图例显示范围
         legend_labels = c("1.0","2.0","3.0","4.0","5.0"),
         #添加图例标签
         #border_color = "black",
         #每个格子的边框色
         border=FALSE,
         #去掉边框线
         display_numbers = TRUE,
         #在每个格子中显示相应的数值
         number_color = "grey" ,
         #数值字体的颜色
         annotation_row = annotation_row,
         annotation_col = annotation_col
         #添加注释
         )

library(ComplexHeatmap)
annotation = data.frame(value = rnorm(10))
value = 1:10
anno= HeatmapAnnotation(df = annotation, points = anno_points(value),
                       annotation_height = c(1, 2))
#添加热图注释和散点注释
Heatmap(test,name = "test", #设定图例标题
        row_title = "Test", column_title = "Gene",
        #坐标标题
        cluster_columns = FALSE, #对列不聚类
        clustering_distance_rows = "pearson",
        #设定行聚类的距离方法，默认为"euclidean"
        top_annotation =anno,
        #注释
        )

library(heatmap.plus)
z = matrix(rnorm(30),nrow=5,ncol=6)
rlab = matrix(as.character(c(1:5,2:6,3:7,4:8)),nrow=5,ncol=4)
clab = matrix(as.character(c(1:6,6:1)),nrow=6,ncol=2)
colnames(rlab) = LETTERS[1:dim(rlab)[2]]
colnames(clab) = 1:dim(clab)[2]
heatmap.plus(z,ColSideColors=clab,RowSideColors=rlab)

levelplot(test)

#构建数据
x <- seq(pi/4, 5 * pi, length.out = 100)
y <- seq(pi/4, 5 * pi, length.out = 100)
r <- as.vector(sqrt(outer(x^2, y^2, "+")))
grid <- expand.grid(x=x, y=y)
grid$z <- cos(r^2) * exp(-r/(pi^3))

levelplot(z ~ x * y,
          #z是一个数值响应，x, y是在矩形网格上计算的数值
          grid,
          #对于公式方法，一种可选的数据框架
          cuts = 50,
          #z的将被划分的levels数目
          scales=list(log="e"),
          xlab="",ylab="",
          main="Weird Function",  #标题
          sub="with log scales",  #子标题
          colorkey = FALSE,
          #是否在绘图旁边绘制颜色键
          region = TRUE
          #等高线之间的区域是否应像等值线图那样填充
          )

levelplot(z ~ x * y, grid,
          col.regions = topo.colors(10),
          #颜色变化
          at = c(-Inf, seq(-0.8, 0.8, by = 0.2), Inf)
          #at，数值向量，指定颜色的变化位置
          )

library(highcharter)
###创建数据
nyears <- 5
df <- expand.grid(seq(12) - 1, seq(nyears) - 1)
df$value <- abs(seq(nrow(df)) + 10 * rnorm(nrow(df))) + 10
df$value <- round(df$value, 2)
ds <- list_parse2(df)
##绘图
hc <- highchart() %>%
  hc_chart(type = "heatmap") %>%
  hc_title(text = "Simulated values by years and months") %>%
  hc_xAxis(categories = month.abb) %>%
  hc_yAxis(categories = 2016 - nyears + seq(nyears)) %>%
  hc_add_series(name = "value", data = ds)
hc_colorAxis(hc, minColor = "#FFFFFF", maxColor = "#434348")

library(heatmaply)
data(mtcars)

heatmaply(iris[,-5], k_row = 3, k_col = 2)

heatmaply(mtcars, k_row = 3, k_col = 2, grid_gap = 1)

library(iheatmapr)
library(ggdendro)
#构建数据
mat <- matrix(rnorm(24), nrow = 6)
mat2 <- matrix(rnorm(24), nrow = 6)
annotation = data.frame(gender = c(rep("M", 3),rep("F",3)))
iheatmap(mat,
         cluster_rows = "hclust",
         cluster_cols = "hclust",  #聚类方法
         col_k = 3) %>%
add_iheatmap(mat2,  #再添加一组热图
          cluster_cols = "hclust",
          col_k = 3,
          row_annotation = annotation)