R-如何绘制显示显着相关性的热图？

Question

我有一个很大的热图。我想通过仅显示 spearman 相关性大于 0.5 且低于 -0.5 的变量来更清楚地绘制它。这会产生一个带有空格的相关矩阵，以获得更大的相关性。因此热图也有空格。我想要一个以所描述的方式显示相关性的热图（当 p.value 低于 0.05 时使用 *），但空格不是白色而是适当的颜色。

此代码生成带有空格的热图，如何将正确的相关性放回矩阵中，以提供热图？ 如何避免热图中的空白？

library(tidyverse)
library(ggplot2)  
library(gplots)

#data.frame
df <- data.frame(var.1 = c('gucci','prada','lacoste','pseudo','gucci','prada','lacoste','pseudo'),var.2 = c('carat.1','carat.1','carat.1','carat.1','carat.2','carat.2','carat.2','carat.2'),spearman = c(-0.5,0.5,-1,0.02,-0.5,0.5,-1,0.02),p.value = c(0.05,0.5,1,0.03,0.05,0.5,1,0.03))

#only spearman greater 0.5 and lower -0.5
df.spe <- df[df$spearman >= 0.5 | df$spearman <= -0.5,]

#heatmap matrix
sub <- df.spe %>%  dplyr::select(.,everything(),-starts_with('p.adj.log')) %>% pivot_wider(.,names_from = 'var.1',values_from = 'estimate') %>%
    column_to_rownames(.,'var.2') %>% data.matrix(.)

sub2 <- df.spe  %>% dplyr::select(.,everything(),-starts_with('estimate')) %>% pivot_wider(.,names_from = 'var.1',values_from = 'p.adj.log') %>%
    column_to_rownames(.,'var.2') %>% data.matrix(.)
sub2 <- ifelse(sub2 >= -log10(0.05),'*','')

#heatmap
heatmap.2(sub,cexRow = .35,cexCol = .35,trace = 'none',key.title = 'Spearman correlation',col = my_palette,keysize = .5,key.par = list(cex=.4) ,notecol = 'black',srtCol = 30,cellnote = sub2)

谢谢 ;)

Answer 1

你没有提供可重复的数据，我不清楚你到底想达到什么目的。

如果我理解正确，您似乎会生成“空格”，但不希望这样，而是只想用星号突出显示重要的案例。

看看下面我的可重现示例，看看它是否能帮助你实现你想要的。

从那里开始，例如，您可以将相关矩阵和 p 值矩阵的 lower.tri（以及 diag，如果您愿意）设置为 NA，而不是集群热图的行和列（如果您愿意）只保留三角矩阵并将其余部分留空。

library(Hmisc)         # for correlations and p-values
library(RColorBrewer)  # for color palette
library(gplots)

# define a color palette
my_palette <- colorRampPalette(rev(brewer.pal(n = 7, name = "RdYlBu")))(100)

# generate reproducible matrix to calculate correlations on
set.seed(23)
mat <- matrix(stats::runif(100, 3, 14), nrow = 10, ncol = 10,
              dimnames = list(paste0("Brand", 1:10), paste0("Val", 1:10)))
modmat <- sample(1:10, 4)
mat[modmat, 1:5] <- mat[modmat,1:5] + stats::runif(20, 4, 6)
mat[modmat, 6:10] <- 14-mat[modmat, 1:5] # for negative correlation

# calculate spearman-rank correlation
cor.mat <- rcorr(t(mat), type = "spearman")

# only keep comparisons that have some abs. correlation >= .5 (optional)
keep <- rownames(cor.mat$r)[rowSums(abs(cor.mat$r)>=0.5) > 1]
cor.mat <- lapply(cor.mat, function(x) x[keep, keep])

# set diagonal to 1, since it is not interesting and should not be marked
diag(cor.mat$P) <- 1

# plot heatmap and mark cells with abs(r) >= .5 and p < 0.05
heatmap.2(cor.mat$r, 
          # cexRow = .35, cexCol = .35, 
          trace = 'none',
          key.title = 'Spearman correlation',
          # keysize = .5, key.par = list(cex=.4), 
          notecol = 'black', srtCol = 30, 
          col = my_palette,
          cellnote = ifelse(cor.mat$P < 0.05 & abs(cor.mat$r)>=0.5, "*", ""))

^{由reprex package (v1.0.0) 于 2021 年 2 月 22 日创建}