详细介绍参见原文

介绍

已经有很多热图包了，如heatmap、大名鼎鼎的ComplexHeatmap等，够让人赏(yan)心(hua)悦(liao)目(luan)了，heatmaply究竟有什么卵用呢？

它可以绘制交互热图，鼠标点点点就可以看到每个小块的数值、还可以放大、缩小。

安装和加载

install.packages('heatmaply')
library("heatmaply")

基本用法

heatmaply(mtcars)

截屏2020-01-12下午3.27.09.png

相关性热图

heatmaply_cor(
  cor(mtcars),
  xlab = "Features",
  ylab = "Features",
  k_col = 2,
  k_row = 2
)

截屏2020-01-12下午3.29.22.png

更高级的相关性热图

r <- cor(mtcars)
## We use this function to calculate a matrix of p-values from correlation tests
## https://stackoverflow.com/a/13112337/4747043
cor.test.p <- function(x){
    FUN <- function(x, y) cor.test(x, y)[["p.value"]]
    z <- outer(
      colnames(x), 
      colnames(x), 
      Vectorize(function(i,j) FUN(x[,i], x[,j]))
    )
    dimnames(z) <- list(colnames(x), colnames(x))
    z
}
p <- cor.test.p(mtcars)

heatmaply_cor(
  r,
  node_type = "scatter",
  point_size_mat = -log10(p), 
  point_size_name = "-log10(p-value)",
  label_names = c("x", "y", "Correlation")
)

截屏2020-01-12下午3.31.09.png

数据转化（缩放、规一化和百分比化）

heatmaply(
  mtcars, 
  xlab = "Features",
  ylab = "Cars", 
  scale = "column",
  main = "Data transformation using 'scale'"
)

截屏2020-01-12下午3.35.47.png

heatmaply(
  normalize(mtcars),
  xlab = "Features",
  ylab = "Cars", 
  main = "Data transformation using 'normalize'"
)

截屏2020-01-12下午3.36.57.png

heatmaply(
  percentize(mtcars),
  xlab = "Features",
  ylab = "Cars", 
  main = "Data transformation using 'percentize'"
)

截屏2020-01-12下午3.37.55.png

缺失值可视化

heatmaply_na(
  airquality[1:30, ],
  showticklabels = c(TRUE, FALSE),
  k_col = 3,
  k_row = 3
)

截屏2020-01-12下午3.39.40.png

更换调色板

heatmaply(
  percentize(mtcars),
  colors = heat.colors(100)
)

截屏2020-01-12下午3.42.57.png

heatmaply(
  mtcars,
  scale_fill_gradient_fun = ggplot2::scale_fill_gradient2(
    low = "blue", 
    high = "red", 
    midpoint = 200, 
    limits = c(0, 500)
  )
)

截屏2020-01-12下午3.43.59.png

自定义树状图和注释

heatmaply(
  percentize(mtcars)[1:10, ],
  seriate = "OLO"
)

截屏2020-01-12下午3.46.38.png

heatmaply(
  percentize(mtcars)[1:10, ],
  seriate = "GW"
)

截屏2020-01-12下午3.47.26.png

heatmaply(
  percentize(mtcars)[1:10, ],
  seriate = "mean"
)

截屏2020-01-12下午3.48.08.png

heatmaply(
  percentize(mtcars)[1:10, ],
  seriate = "none"
)

截屏2020-01-12下午3.48.39.png

使用dendextend定制树状图

x  <- as.matrix(datasets::mtcars)
library("dendextend")

row_dend  <- x %>% 
  dist %>% 
  hclust %>% 
  as.dendrogram %>%
  set("branches_k_color", k = 3) %>% 
  set("branches_lwd", c(1, 3)) %>%
  ladderize
# rotate_DendSer(ser_weight = dist(x))
col_dend  <- x %>% 
  t %>% 
  dist %>% 
  hclust %>% 
  as.dendrogram %>%
  set("branches_k_color", k = 2) %>% 
  set("branches_lwd", c(1, 2)) %>%
  ladderize
#    rotate_DendSer(ser_weight = dist(t(x)))

heatmaply(
  percentize(x),
  Rowv = row_dend,
  Colv = col_dend
)

截屏2020-01-12下午3.50.46.png

用RowSideColors添加额外注释

x  <- as.matrix(datasets::mtcars)
rc <- colorspace::rainbow_hcl(nrow(x))

library("gplots")

library("viridis")
heatmap.2(
  x,
  trace = "none",
  col = viridis(100),
  RowSideColors = rc,
  key = FALSE
)

image.png

heatmaply(
  x,
  seriate = "mean",
  RowSideColors = rc
)

截屏2020-01-12下午3.56.35.png

heatmaply(
  x[, -c(8, 9)],
  seriate = "mean",
  col_side_colors = c(rep(0, 5), rep(1, 4)),
  row_side_colors = x[, 8:9]
)

截屏2020-01-12下午3.57.32.png

文本注释

heatmaply(
  mtcars,
  cellnote = mtcars
)

截屏2020-01-12下午3.58.34.png

mat <- mtcars
mat[] <- paste("This cell is", rownames(mat))
mat[] <- lapply(colnames(mat), function(colname) {
    paste0(mat[, colname], ", ", colname)
})
heatmaply(
  mtcars,
  custom_hovertext = mat
)

截屏2020-01-12下午3.59.47.png

还可以绘制静态图

ggheatmap(
  mtcars,
  scale = "column",
  row_side_colors = mtcars[, c("cyl", "gear")]
)

image.png