在具有最高相关性的 k 个数据帧中找到 n 个向量的组合

Question

假设有四个数据帧，每个数据帧有 3 个向量，例如

setA <- data.frame(
  a1 = c(6,5,2,4,5,3,4,4,5,3),
  a2 = c(4,3,1,4,5,1,1,6,3,2),
  a3 = c(5,4,5,6,4,6,5,5,3,3)
)

setB <- data.frame(
  b1 = c(5,3,4,3,3,6,4,4,3,5),
  b2 = c(4,3,1,3,5,2,5,2,5,6),
  b3 = c(6,5,4,3,2,6,4,3,4,6)
)

setC <- data.frame(
  c1 = c(4,4,5,5,6,4,2,2,4,6),
  c2 = c(3,3,4,4,2,1,2,3,5,4),
  c3 = c(4,5,4,3,5,5,3,5,5,6)
)

setD <- data.frame(
  d1 = c(5,5,4,4,3,5,3,5,5,4),
  d2 = c(4,4,3,3,4,3,4,3,4,5),
  d3 = c(6,5,5,3,3,4,2,5,5,4)
)

我试图在每个数据帧中找到 n 个向量，它们之间的相关性最高。对于这个简单的例子，假设想要在每个 k = 4 数据帧中找到 n = 1 向量，它们显示出整体最强的正相关性 cor().

我对数据帧内向量的相关性不感兴趣，但对数据帧之间的相关性不感兴趣，因为我想从每组中选择 1 个变量。

凭直觉，我会对每个组合的所有相关系数求和，即：

sum(cor(cbind(setA$a1, setB$b1, setC$c1, setC$d1)))
sum(cor(cbind(setA$a1, setB$b2, setC$c1, setC$d1)))
sum(cor(cbind(setA$a1, setB$b1, setC$c2, setC$d1)))
... # and so on...

...但这似乎是通过某种聚类技术暴力破解一个可能更优雅地解决的解决方案？

无论如何，我希望找到一个像 function(n = 1, ...) 这样的动态解决方案，其中（... 对于数据帧）将 return 一个最高相关向量名称的列表。

Answer 1

根据您的示例，除非您的实际数据量很大，否则我不会使用非常复杂的算法。我认为这是一种简单的方法可以得到你想要的。因此，基于您的 4 个数据框，a 创建了 list_df，然后在函数中我只生成所有可能的变量组合并计算它们的相关性。最后我 select 具有最高相关性的 n 个组合。

list_df = list(setA,setB,setC,setD)

CombMaxCor = function(n = 1,list_df){

  column_names = lapply(list_df,colnames)
  mat_comb     = expand.grid(column_names)
  mat_total    = do.call(cbind,list_df)
  vec_cor      = rep(NA,nrow(mat_comb))

  for(i in 1:nrow(mat_comb)){
    vec_cor[i] = sum(cor(mat_total[,as.character(unlist(mat_comb[i,]))]))
  }
  pos_max_temp = rev(sort(vec_cor))[1:n]
  pos_max      = vec_cor%in%pos_max_temp
  comb_max_cor = mat_comb[pos_max,]
  return(comb_max_cor)
}

Answer 2

您可以使用 comb 函数：

fun = function(x){
  nm = paste0(names(x),collapse="")
  if(!grepl("(.)\d.*\1",nm,perl = T))
    setNames(sum(cor(x)),nm)
}
unlist(combn(a,4,fun,simplify = FALSE))[1:3]#Only printed the first 3

a1b1c1d1 a1b1c1d2 a1b1c1d3 
3.246442 4.097532 3.566949 

sum(cor(cbind(setA$a1, setB$b1, setC$c1, setD$d1)))
[1] 3.246442
sum(cor(cbind(setA$a1, setB$b1, setC$c1, setD$d2)))
[1] 4.097532
sum(cor(cbind(setA$a1, setB$b1, setC$c1, setD$d3)))
[1] 3.566949

Answer 3

这是一个我们可以用来从每个数据帧中获取 n 个非重复列以获得最大总相关性的函数：

func <- function(n, ...){

    list.df <- list(...)
    n.df <- length(list.df)


    # 1) First get the correlations
    get.two.df.cors <- function(df1, df2) apply(df1, 2, 
        function(x) apply(df2, 2, function(y) cor(x,y))
        )
    cor.combns <-  lapply(list.df, function(x) 
        lapply(list.df, function(y) get.two.df.cors(x,y))
        )


    # 2) Define function to help with aggregating the correlations.
    # We will call them for different combinations of selected columns from each df later

    # cmbns: given a df corresponding columns to be selected each data frame
    # (i-th row corresponds to i-th df),
    # return the "total correlation"


    get.cmbn.sum <- function(cmbns, cor.combns){
        # a helper matrix to help aggregation
        # each row represents which two data frames we want to get the correlation sums
        df.df <- t(combn(seq(n.df), 2, c))

        # convert to list of selections for each df
        cmbns <- split(cmbns, seq(nrow(cmbns)))

        sums <- apply(df.df, 1,
          function(dfs) sum(
             cor.combns[[dfs[1]]][[dfs[2]]][cmbns[[dfs[2]]], cmbns[[dfs[1]]]] 
          )
        )

        # sum of the sums give the "total correlation"
        sum(sums)
    }



    # 3) Now perform the aggragation

    # get the methods of choosing n columns from each of the k data frames
    if (n==1) {
    cmbns.each.df <- lapply(list.df, function(df) matrix(seq(ncol(df)), ncol=1))
    } else {
    cmbns.each.df <- lapply(list.df, function(df) t(combn(seq(ncol(df)), n, c)))
    }

    # get all unique selection methods
    unique.selections <- Reduce(function(all.dfs, new.df){
        all.dfs.lst <- rep(list(all.dfs), nrow(new.df))
        all.new.rows <- lapply(seq(nrow(new.df)), function(x) new.df[x,,drop=F])
        for(i in seq(nrow(new.df))){
            for(j in seq(length(all.dfs.lst[[i]]))){
                all.dfs.lst[[i]][[j]] <- rbind(all.dfs.lst[[i]][[j]], all.new.rows[[i]])
            }
        }

        do.call(c, all.dfs.lst)

    }, c(list(list(matrix(numeric(0), nrow=0, ncol=n))), cmbns.each.df))

    # for each unique selection method, calculate the total correlation
    result <- sapply(unique.selections, get.cmbn.sum, cor.combns=cor.combns)
    return( unique.selections[[which.max(result)]] )

}

现在我们有：

# n = 1
func(1, setA, setB, setC, setD)
#      [,1]
# [1,]    1
# [2,]    2
# [3,]    3
# [4,]    2

# n = 2
func(2, setA, setB, setC, setD)
#      [,1] [,2]
# [1,]    1    2
# [2,]    2    3
# [3,]    2    3
# [4,]    2    3

在具有最高相关性的 k 个数据帧中找到 n 个向量的组合

Find combination of n vectors across k dataframes with highest correlation

r

cluster-analysis

correlation