有没有一种快速的方法可以在上部面板上显示皮尔逊相关性，在下部面板上显示Spearman相关性？

Question

库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")

以一种更加优雅的方式。

Answer 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())

Answer 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")

Answer 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)