r - 用于重复距离矩阵计算和超大距离矩阵分块的高效(内存方面)函数

Question

我想知道是否有人可以看一下下面的代码和最小的示例并提出改进建议 - 特别是在处理非常大的数据集时代码的效率。

该函数采用 data.frame 并将其按分组变量(因子)分割，然后计算每组中所有行的距离矩阵。

我不需要保留距离矩阵 - 只需要一些统计数据，即平均值、直方图..，然后可以将它们丢弃。

我对内存分配等了解不多，并且想知道执行此操作的最佳方法是什么，因为我将处理每组 10.000 - 100.000 个案例。任何想法将不胜感激!

此外，如果我遇到严重的内存问题，将 bigmemory 或其他一些大数据处理包包含到函数中最不痛苦的方法是什么？

FactorDistances <- function(df) {
  # df is the data frame where the first column is the grouping variable. 
  # find names and number of groups in df (in the example there are three:(2,3,4)
  factor.names <- unique(df[1])
  n.factors <-length(unique(df$factor))
  # split df by factor into list - each subset dataframe is one list element
  df.l<-list()
  for (f in 1:n.factors) {df.l[[f]]<-df[which(df$factor==factor.names[f,]),]}
  # use lapply to go through list and calculate distance matrix for each group
  # this results in a new list where each element is a distance matrix
  distances <- lapply (df.l, function(x) dist(x[,2:length(x)], method="minkowski", p=2))  
  # again use lapply to get the mean distance for each group
  means <- lapply (distances,  mean)  
  rm(distances)
  gc()
  return(means)
}

df <- data.frame(cbind(factor=rep(2:4,2:4), rnorm(9), rnorm(9)))
FactorDistances(df)
# The result are three average euclidean distances between all pairs in each group
# If a group has only one member, the value is NaN

编辑:我编辑了标题以反射(reflect)我作为答案发布的分块问题..

Answer 1

我为那些 dist() 无法处理的超大矩阵提出了一个分块解决方案，我将其发布在这里，以防其他人发现它有帮助(或者发现它的错误，请!)。它比 dist() 慢得多，但这有点无关紧要，因为它只能在 dist() 抛出错误时使用 - 通常是以下错误之一:

"Error in double(N * (N - 1)/2) : vector size specified is too large" 
"Error: cannot allocate vector of size 6.0 Gb"
"Error: negative length vectors are not allowed"

该函数计算矩阵的平均距离，但您可以将其更改为其他任何值，但如果您想实际保存矩阵，我相信某种文件备份的大内存矩阵是合适的。感谢 link感谢这个想法，感谢阿里的帮助!

FunDistanceMatrixChunking <- function (df, blockSize=100){
  n <- nrow(df)
  blocks <- n %/% blockSize
  if((n %% blockSize) > 0)blocks <- blocks + 1
  chunk.means <- matrix(NA, nrow=blocks*(blocks+1)/2, ncol= 2)
  dex <- 1:blockSize
  chunk <- 0
  for(i in 1:blocks){    
    p <- dex + (i-1)*blockSize
    lex <- (blockSize+1):(2*blockSize)
    lex <- lex[p<= n]
    p <- p[p<= n]
    for(j in 1:blocks){
      q <- dex +(j-1)*blockSize
      q <- q[q<=n]     
      if (i == j) {       
        chunk <- chunk+1
        x <- dist(df[p,])
        chunk.means[chunk,] <- c(length(x), mean(x))}
      if ( i > j) {
        chunk <- chunk+1
        x <- as.matrix(dist(df[c(q,p),]))[lex,dex] 
        chunk.means[chunk,] <- c(length(x), mean(x))}
    }
  }
  mean <- weighted.mean(chunk.means[,2], chunk.means[,1])
  return(mean)
}
df <- cbind(var1=rnorm(1000), var2=rnorm(1000))
mean(dist(df))
FunDistanceMatrixChunking(df, blockSize=100)

不确定我是否应该将其发布为编辑，而不是答案。它确实解决了我的问题，尽管我并没有真正以这种方式指定它。