从多重相关数据中删除高度相关的变量

问题描述 投票：0回答：1

我有一个非常大的数据框，包含 200 多个变量。
我正在运行 

cor()
以获得具有相关值的矩阵，然后使用函数 
caret::findCorrelation
，调用 
findCorrelation(x, cutoff = 0.8)
来查找高度相关的变量。之后，我想从我的数据中一一删除高度相关的变量，直到不再有高度相关的变量。

因为某些变量与 40 多个其他变量高度相关，所以我确实运行了特征重要性分析（使用 

Boruta()
，包 
Boruta
）来确定这些变量的重要性，并根据我开始删除一个变量的重要性一次变量（从最低平均重要性变量开始（最低 
meanImp
）。

这是我尝试编码的过程 - 第一次迭代是使用具有最低

meanImp
的变量，检查该变量是否高度相关（
abs(correlation indices) >= 0.8
），如果是，则从数据中删除（如果不保留），然后我更新通过运行 
cor()
来计算相关矩阵，然后寻找具有第二低 
meanImp
的下一个变量，所以我这样做，直到在矩阵/数据中找不到更多高度相关的变量。

这是我使用的代码：

remove_highly_correlated <- function(data, confirmed_sorted, cutoff = 0.80) {
  removed_vars <- character(0)
  
  while (TRUE) {
    removed_this_iteration <- FALSE  
    
    for (i in 1:nrow(confirmed_sorted)) {
      var <- as.character(confirmed_sorted$variables[i])
      
      if (var %in% colnames(data)) {
        cor_matrix <- cor(data)  
        hc <- findCorrelation(cor_matrix, cutoff = cutoff)
        
        if (length(hc) > 0 && var %in% rownames(cor_matrix)[hc]) {
          message(paste("Variable", var, "is highly correlated, removing..."))
          removed_vars <- c(removed_vars, var)  
          data <- data[, -which(colnames(data) == var)]  
          removed_this_iteration <- TRUE  
          break 
        }
      }
    }
    
    if (!removed_this_iteration) {
      break  
    }
  }
  
  return(list(data = data, removed_vars = removed_vars))
}

result <- remove_highly_correlated(data5, confirmed_sorted)

data5_filtered <- as.data.frame(result$data)
removed_variables <- as.data.frame(result$removed_vars)

cor_d5 = round(cor(data5_filtered), 4)
hc = findCorrelation(cor_d5, cutoff = 0.80, verbose = TRUE)

其中 

confirmed_sort
是具有平均重要性的数据，
data5
是我的主要数据（我在下面提供了一些简短版本的数据）。

此代码以某种方式起作用，因为在代码完成后，我测试了我的最终数据是否仍然具有高度相关的变量，并且我仍然有 6 个变量位于 

confirmed_sort
数据中。

下面提供的数据只是一个示例，它不会产生数据中剩余的高度相关的变量。

blue <- c(0.57, 0.76, 0.78, 0.53, 0.26, 0.27, 0.32, 0.20, 0.63, 0.68, 0.69, 0.69, 0.35, 0.51, 0.39, 0.57, 0.67, 0.63, 0.66, 0.61, 0.54, 0.51, 0.56, 0.59, 0.52, 0.40, 0.39, 0.46, 0.82, 0.84, 0.83, 0.52, 0.59, 0.70, 0.61, 0.83)
red <- c(0.14, 0.11, 0.15, 0.17, 0.18, 0.17, 0.16, 0.07, 0.07, 0.11, 0.12, 0.10, 0.27, 0.19, 0.23, 0.19, 0.10, 0.11, 0.09, 0.10, 0.17, 0.23, 0.23, 0.22, 0.24, 1.00, 0.88, 0.64, 0.11, 0.12, 0.14, 0.56, 0.54, 0.36, 0.53, 0.13)
purple <- c(0.80, 0.84, 0.79, 0.76, 0.75, 0.76, 0.77, 0.59, 0.90, 0.84, 0.83, 0.86, 0.64, 0.73, 0.68, 0.73, 0.85, 0.83, 0.86, 0.85, 0.76, 0.69, 0.69, 0.71, 0.68, 0.00, 0.09, 0.28, 0.84, 0.83, 0.80, 0.35, 0.36, 0.55, 0.38, 0.81)
pink <- c(0.67, 0.73, 0.66, 0.62, 0.63, 0.63, 0.64, 0.49, 0.84, 0.74, 0.73, 0.78, 0.51, 0.58, 0.52, 0.59, 0.74, 0.72, 0.77, 0.75, 0.64, 0.54, 0.55, 0.57, 0.54, 0.00, 0.06, 0.18, 0.74, 0.73, 0.68, 0.25, 0.24, 0.41, 0.26, 0.69)
orange <- c(0.14, 0.11, 0.15, 0.17, 0.18, 0.17, 0.16, 0.07, 0.07, 0.11, 0.12, 0.10, 0.27, 0.19, 0.23, 0.19, 0.10, 0.11, 0.09, 0.10, 0.17, 0.23, 0.23, 0.22, 0.24, 1.00, 0.88, 0.64, 0.11, 0.12, 0.14, 0.56, 0.54, 0.36, 0.53, 0.13)
yellow <- c(0.20, 0.16, 0.21, 0.24, 0.25, 0.24, 0.23, 0.41, 0.10, 0.16, 0.17, 0.14, 0.36, 0.27, 0.32, 0.27, 0.15, 0.17, 0.14, 0.15, 0.24, 0.31, 0.31, 0.29, 0.32, 1.00, 0.91, 0.72, 0.16, 0.17, 0.20, 0.65, 0.64, 0.45, 0.62, 0.19)

data5 <- data.frame(blue, red, purple, pink, orange, yellow)

variables <- c("yellow", "purple", "blue", "green", "pink", "orange", "red")
meanImp <- c(10.07, 9.40, 9.31, 7.51, 7.49, 6.82, 6.65)

confirmed_sorted<- data.frame(variables, meanImp)

如果我没有遗漏函数代码中的任何内容，请解释为什么我的数据中仍然存在高度相关的变量。任何其他用于从数据中删除高度变量的方法也是受欢迎的。谢谢你。

r correlation r-caret
1个回答
1
投票

将函数分解为更简单的函数。他们每个人只做一件事。
就像问题评论中的讨论中所说，首先调用 

Boruta
来确定数据集中变量的变量重要性。然后找到高度相关的，并删除平均重要性最低的。重复此操作，直到删除 o 变量。

测试使用从

help("Boruta")
中的示例中获取的数据集运行。

library(caret)
library(Boruta)

# X - regressors, can be a data.frame
# Y - response, a 1-dim vector
runBoruta <- function(X, Y, verbose = FALSE, ...) {
  vars <- names(X)
  Brt <- Boruta(X, Y, ...)
  if(verbose) {
    message("Running 'Boruta' algorithm")
    print(Brt)
  }
  i_meanImp <- nrow(Brt$ImpHistory)
  meanImp <- Brt$ImpHistory[i_meanImp, vars]
  meanImp <- meanImp[is.finite(meanImp)] |> sort()
  meanImp |>
    as.data.frame() |> 
    cbind(variables = names(meanImp))
}
remove_one_var <- function(X, confirmed_sorted, cutoff = 0.80) {
  cor_matrix <- cor(X)
  hc <- findCorrelation(cor_matrix, cutoff = cutoff)
  if (length(hc) > 0) {
    i <- confirmed_sorted$meanImp[hc] |> which.min()
    v <- confirmed_sorted$variables[ hc[i] ]
    message(paste("Variable", v, "is highly correlated, removing..."))
    X <- X[, -hc[i] ]  
  } else v <- character(0L)
  return(list(data = X, removed = v))
}
remove_highly_correlated <- function(data, resp, cutoff, verbose = FALSE) {
  work <- data[names(data) != resp]
  Y <- data[[resp]]
  rmvd <- character(0L)
  repeat {
    confirmed_sorted <- runBoruta(work, Y, pValue = 0.05, verbose = verbose)
    work <- work[confirmed_sorted$variables]
    result <- remove_one_var(work, confirmed_sorted, cutoff)
    if(length(result$removed) == 0) break
    work <- result$data
    rmvd <- c(rmvd, result$removed)
  }
  list(data = result$data, removed_vars = rmvd)
}

测试

这些是我进行的测试。

第一次测试

在第一个数据集测试中

srx
，

  • Boruta
    丢弃 3 个不重要的特征，
    N1, N2, N3
    ；
  • 然后
    findCorrelation
    得到一个高度相关的特征来删除，
    nA
    ：
  • 然后函数迭代，直到没有特征被认为是重要的。
data(srx, package = "Boruta")
srx[] <- lapply(srx, as.integer)
cutoff <- 0.8

set.seed(2024)
result1 <- remove_highly_correlated(srx, "Y", cutoff = cutoff, verbose = TRUE)
#> Running 'Boruta' algorithm
#> Boruta performed 18 iterations in 0.282912 secs.
#>  5 attributes confirmed important: A, AnB, AoB, B, nA;
#>  3 attributes confirmed unimportant: N1, N2, N3;
#> Variable nA is highly correlated, removing...
#> Running 'Boruta' algorithm
#> Boruta performed 7 iterations in 0.0775032 secs.
#>  4 attributes confirmed important: A, AnB, AoB, B;
#>  No attributes deemed unimportant.

第二次测试


iris.extended <- data.frame(iris, apply(iris[,-5], 2L, sample))
names(iris.extended)[6:9] <- paste("Nonsense", 1:4, sep = "")

set.seed(2024)
result2 <- remove_highly_correlated(iris.extended, "Species", cutoff = cutoff)
#> Variable Petal.Length is highly correlated, removing...
#> Variable Petal.Width is highly correlated, removing...

result2$data |> head()
#>   Nonsense2 Sepal.Width Sepal.Length
#> 1       3.1         3.5          5.1
#> 2       4.1         3.0          4.9
#> 3       3.8         3.2          4.7
#> 4       3.0         3.1          4.6
#> 5       3.1         3.6          5.0
#> 6       2.9         3.9          5.4
result2$removed_vars
#> [1] "Petal.Length" "Petal.Width"

创建于 2024-03-21，使用 reprex v2.1.0

最新问题
© www.soinside.com 2019 - 2024. All rights reserved.