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

Question

I have a big heatmap. I want to plot it more clearly by showing only variables with a spearman correlation greater 0.5 and lower -0.5. This results in a correlation matrix with blank spaces for greater correlations. Therefore the heatmap has blank spaces as well. I want a heatmap that shows correlations in the descripted way (with * when p.value below 0.05) but blank spaces are not colored white but in the appropiate color.

This code generates a heatmap with blank spaces, how to put the right correlations back into the matrix, that feeds the heatmap? How to avoid blank spaces in the heatmap?

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)

Thanks;)

Answer 1

You have not provided reproducible data and it is not clear to me what exactly you are trying to achieve.

If I understand correctly, you seem to generate "blank spaces", yet don't want that, and instead just want to highlight significant cases with a star symbol.

Have a look at my reproducible example below and see if that helps you achieve what you want.

Going from there, you could for example set lower.tri (and diag , if you like) of the correlation and p-value matrices to NA and not cluster rows and columns of the heatmap if you want to just keep triangular matrix and blank out the rest.

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, "*", ""))

^{Created on 2021-02-22 by the reprex package (v1.0.0)}