有没有快速的方法可以在上面板显示 Pearson 相关性，在下面板显示 Spearman 相关性？答案

【问题标题】：Is there fast way to present Pearson correlation on the upper panel and Spearman correlation on the lower panel?有没有快速的方法可以在上面板显示 Pearson 相关性，在下面板显示 Spearman 相关性？
【发布时间】：2019-08-27 06:48:09
【问题描述】：

库corrgram 提供了绘制优雅相关图的机会。但是，文档中没有简单的方法可以在同一张图上同时获得 Spearman 和 Pearson 相关性。

也许计算两个系数的相关矩阵并粘贴它们是一种选择，但这似乎不是正确的方法。

我认为这张图片可以正确解释我想要得到的东西：

我想得到：

cors <- cor(state.x77, method = "pearson")
corsSp <- cor(state.x77, method = "spearman")
for(i in 1:nrow(cors))
{
for(j in i:ncol(cors))
{
cors[i,j] <- corsSp[i,j]
m[i,j] <- j
}
}
corrgram(cors, type = "corr")

以更优雅的方式。

【问题讨论】：

您能否提供数据集的样本或使用内置数据集来说明失败的尝试？
corrgram 只允许 pearson-correlations，来源：github.com/kwstat/corrgram/blob/master/R/corrgram.r
我已经编辑了我的问题，提供了一些代码。为了获得 Spearman 相关性，我使用 corrgram(state.x77, cor.method = "spearman")

标签： r graphics correlation

【解决方案1】：

您可以尝试通过ggplot 手动重建您的图表，这会产生非常相似的结果（图案背景除外）：

library(ggplot2)
library(tibble)
library(dplyr)
library(tidyr)

## transform the cor matrix (with pearons and spearmann coeeficients) 
cor_cleaned <- cors %>%
  as.data.frame() %>%
  rownames_to_column("x") %>%
  as_tibble() %>%
  gather(y, cor, -x) %>%
  mutate(x   = factor(x, unique(x)),
         y   = factor(y, rev(levels(x))),
         dir = factor(sign(cor)))

cor_tri <- cor_cleaned %>%
  filter(x != y)

cor_diag <- cor_cleaned %>%
  filter(x == y)

ggplot(cor_tri, aes(x, y, alpha = abs(cor), fill = dir)) +
  geom_tile(show.legend = FALSE, color = "gray") +
  geom_tile(show.legend = FALSE, color = "gray", fill = NA, data = cor_diag) +
  geom_text(aes(label = y), data = cor_diag, show.legend = FALSE) + 
  scale_fill_manual(values = c("1" = "navy", "-1" = "red")) +
  theme_minimal() +
  theme(panel.grid = element_blank(),
        axis.text  = element_blank(),
        axis.title = element_blank())

【讨论】：

【解决方案2】：

以这些数据为例：

df = data.frame(x = runif(100),
                y = runif(100),
                z = runif(100),
                w = runif(100),
                v = runif(100),
                u = runif(100))

计算相关矩阵：

library("dplyr")
mat = matrix(NA, nrow = ncol(df), ncol = ncol(df)) %>%
  `row.names<-`(names(df)) %>%
  `colnames<-`(names(df))


mat[upper.tri(mat)] = cor(df,method="pearson")[upper.tri(mat)]
mat[lower.tri(mat)] = cor(df,method="spearman")[lower.tri(mat)]

从长格式转换为宽格式：

cor.long = reshape2::melt(mat)

然后绘制：

library("ggplot2")
library("RColorBrewer")

pal = colorRampPalette(rev(brewer.pal(11, "Spectral")))

ggplot(cor.long, aes(Var1, factor(Var2, rev(levels(Var2))), fill = value)) +
  geom_tile() +
  geom_text(aes(label = Var1), data = cor.long %>% filter(Var1 == Var2)) + 
  geom_text(aes(label = value %>% round(digits = 3)), data = cor.long %>% filter(Var1 != Var2)) + 
  scale_y_discrete(limits = rev(levels(df$Var2))) +
  scale_fill_gradientn(colours = pal(100), na.value  = "white", limits=c(-.5,.5)) +
  theme(panel.background = element_blank(),
        axis.title = element_blank(),
        axis.text = element_text(angle = 45),
        legend.position = "none")

【讨论】：

【解决方案3】：

计算相关矩阵的另一种方法：

mycor <- Vectorize(function(i, j) {
   method <- ifelse(i>j, "pearson", "spearman")
   cor(state.x77[,i], state.x77[,j], method = method)
})
sqn <- 1:ncol(state.x77)
cors <- outer(sqn, sqn, FUN=mycor)

【讨论】：