r - 基于正相关对矩阵中的变量进行子集化以构建复合指标

Question

我的目标是建立一个综合指标。在进行加权和汇总规则之前，重要的一步是查看指标之间的相关性，正如《经合组织构建综合指标手册》中所述。

请注意，同一聚合的不同度量之间几乎总是存在一些正相关。因此，应该引入一个经验法则来定义一个阈值，超过该阈值相关性就是重复计算的症状。

为了继续进行此操作（即仅选择具有一定相关阈值的积极指标），我尝试了以下操作 - 示例如下

df <- data.frame(
  indic1 = c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 0), 
  indic2 = c(0.28571, 0.5714285, 0.4285714, 0.142857, 0.285714, 1, 0.71428, 0.14285, 0.5714, 0.142, 0, 0.14285, 0.8571, 0.8571427, 0.4285), 
  indic3 = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0), 
  indic4 = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 1, 0), 
  indic5 = c(0, 0, 1, 0, 0, 1, 1, 1, 0, 0, 0, 0, 1, 1, 0.5), 
  indic6 = c(0, 1, 0, 0, 0, 1, 0, 0, 0, 0, 0, 1, 1, 0, 0), 
  indic7 = c(0.5, 0.5, 1, 0.5, 0.5, 0.5, 0.5, 0, 1, 1, 1, 0.5, 1, 0.5, 0), 
  indic8 = c(0, 0, 0.3333, 1, 0.3333, 0.3333, 0.3333, 1, 0, 0.3333, 0.3333, 0.3333, 0, 0, 1), 
  indic9 = c(0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1, 0, 0, 1), 
  indic10 = c(0, 0.2, 1, 0.2, 0.8, 0.4, 0, 0.4, 0.4, 0.8, 0.4, 0.6, 0.4, 0, 0.2), 
  indic11 = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0), 
  indic12 = c(0.5, 0, 0, 0, 1, 0, 0, 1, 0, 0, 0.5, 0, 0, 0, 0), 
  indic13 = c(1, 0, 0, 0, 0, 0, 1, 1, 0, 0, 0, 0, 1, 1, 0), 
  indic14 = c(0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 1, 0, 0, 0, 0), 
  indic15 = c(1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 1, 1), 
  indic16 = c(1, 0, 0, 0, 0, 0, 0, 0, 1, 0, 1, 0, 0, 1, 1), 
  indic17 = c(0.3333, 0.3333, 0.6666, 0, 0.6666, 0.1666, 1, 0.3333, 0.8333, 0.5, 0.1666, 0.5, 0, 0.8333, 0.1666), 
  indic18 = c(0.857142, 0.428571, 0.85714, 0.142857, 0.714285, 0.5714, 0.714285, 0, 0.42857, 0.857142, 0, 0, 1, 0.2857, 0), 
  row.names = c("Area1", "Area2", "Area3", "Area4", "Area5", "Area6", "Area7", "Area8", "Area9", "Area10", "Area11", "Area12", "Area13", "Area14", "Area15"))

## now correlation matrix
    corr.matrix <- cor(df, method = "pearson",  use = "pairwise.complete.obs")

## Visualization with ggplot  
  ggcorrplot(corr.matrix ,
                        method = "circle",
                        hc.order = TRUE,
                        type = "upper")

接下来是子集，特定阈值的相关矩阵（按照此处的示例：R：过滤值的相关矩阵>和<

所以代码是：

corr.matrix0 <- corr.matrix
diag(corr.matrix0) <- 0

##set up threshold
threshold <- 0.6

## Now subsetting but here without absolute value
#ok <- apply(abs(corr.matrix0) >= threshold, 1, any)
ok <- apply( corr.matrix0 >= threshold, 1, any)

## or
# ok <- sort(unique( c(which(abs(corr.matrix0) >= threshold, arr = TRUE))))
# ok <- sort(unique( c(which(corr.matrix0 >= threshold, arr = TRUE))))

corr.matrixnew <-  corr.matrix[ok, ok]
ggcorrplot(corr.matrixnew ,
           method = "circle",
           hc.order = TRUE,
           type = "upper")

但从结果中可以看出，这并没有解决......因为我仍然可以看到一些负相关......

我想应该有一个基于相关矩阵的优化过程——就像一种套索来做到这一点？

有人有这个脚本吗？或者也许我错过了一些东西..

提前致谢！

标签： rsubsetcorrelationindicator

Answer 1

最简单的选择是使用findCorrelationfrom来完成caret。它正是为这种情况而创建的。

# do it with cart
library(caret)
to_remove <- findCorrelation(corr.matrix, cutoff = threshold)

corr.matrix_2 <- cor(df[, -to_remove], method = "pearson",  use = "pairwise.complete.obs")

ggcorrplot(corr.matrix_2 ,
           method = "circle",
           hc.order = TRUE,
           type = "upper")

或者，您可以仅使用基本 R 手动执行此操作：

# do it manually
df2 <- as.data.frame(corr.matrix)
df2[lower.tri(corr.matrix, diag = TRUE)] <- NA

to_remove_2 <- (which(sapply(df2,function(x) any(abs(x) > threshold, na.rm = TRUE))))

corr.matrix_3 <- cor(df[, -to_remove_2], method = "pearson",  use = "pairwise.complete.obs")

ggcorrplot(corr.matrix_3 ,
           method = "circle",
           hc.order = TRUE,
           type = "upper")

编辑： 我可能误解了你。我以为您想删除相关性>阈值的那些。

但是，如果您想保留它们并删除其他人：

df2 <- as.data.frame(corr.matrix)
diag(df2) <- NA
to_keep <- (which(sapply(df2,function(x) any(x > threshold, na.rm = TRUE))))

corr.matrix_4 <- cor(df[, to_keep], method = "pearson",  use = "pairwise.complete.obs")

ggcorrplot(corr.matrix_4 ,
           method = "circle",
           hc.order = TRUE,
           type = "upper")

这可能仍然具有负相关性，因为虽然变量的成对相关性很高，但它们的一些交互作用是负的。

示例：A 到 B > 0.6，C 到 D > 0.6，但 A 到 C < 0

如果您希望所有这些都很高，那么这不是成对的相关性...

EDIT_2：

只选择具有一定相关阈值的积极指标）

如果您只是为了绘图目的而这样做：从相关矩阵中删除负数（或低于阈值的数）并绘制它。

# corr.matrix_4[corr.matrix_4 <= 0] <- NA
corr.matrix_4[corr.matrix_4 <= threshold] <- NA


library(GGally) 
# Using GGally here as ggcorrplot doesn't handle NAs
# Or do it manually: http://www.sthda.com/english/wiki/ggplot2-quick-correlation-matrix-heatmap-r-software-and-data-visualization

ggcorr(corr.matrix_4, cor_matrix = corr.matrix_4, labbel = TRUE)