2

我正在迭代地使用 rdist 来计算大型数据集的最近邻居。目前我有一个相当小的矩阵，包含 6 列的 634,000 个向量。

如前所述，我使用 rdist 来计算每个向量到每个其他向量的距离，每个距离计算都是一个步骤。此外，在每一步我都会运行一个函数来计算 k=1,2,3,4 最近的邻居并取和（实际上是 k=所有邻居）。

###My function to compute k nearest neighbours from distance vector

    knn <- function (vec,k) {
      sum((sort(vec)[1:k+1]))
    }

###My function to compute nearest neighbours iteratively for every vector
myfunc <- function (tab) {

  rowsums <- numeric(nrow(tab)) ###Here I will save total sums
  knnsums_log <- matrix(nrow=nrow(tab),ncol=4) ###Matrix for storing each of my kNN sums

  for(i in 1:nrow(tab)) { ###For loop to compute distance and total sums
    q<-as.matrix(rdist(tab[i,],tab))
    rowsums[i] <- rowSums(q)

     for (k in c(1:4)) { ###Nested loop to run my knn function
     knnsums[i,k] <- knn(q,k) 
    }

  }

  return(cbind(rowsums,knnsums_log))
}

数据样例（634k 行）

    X1  X2  X3  X4  X5  X6
1   0.00    0.02    0   0   0.02    -0.263309267
2   0.00    0.02    0   0   0.02    -0.171764667
3   0.00    0.02    0   0   0.02    -0.128784869
4   0.00    0.02    0   0   0.02    -0.905651733

对于那些不熟悉函数 rdist 的人来说，争论之间的欧几里得距离。它的工作速度比自定义编写的函数快得多。它比 dist 更适用，因为 dist 仅在矩阵距离内计算。从技术上讲，我知道这就是我正在做的事情，但 dist 试图将其存储在内存中，而且它太大了，甚至无法考虑这样做。

我怎样才能使上述工作更好？我尝试过使用应用功能，但没有任何用处。我希望我已经清楚地解释了一切。如果我的数学是正确的，最坏的情况估计需要我一个多星期才能运行该代码。我有非常强大的服务器来处理它。但是没有 GPU。我没有尝试过多核（应该有 12 个可用），但是我不知道我将如何委派每个核心。

谢谢您的帮助。

4

2 回答 2

1

几个提示：

0) 使用 Rprof 分析您的代码，使用 line.profiling 选项

1) R 中的矩阵是按列排列的。因为您比较它们之间的向量，所以如果将它们存储为矩阵的列会快得多

2）我不知道 rdist 函数来自哪里，但是你应该避免使用 as.matrix(rdist(tab[i,],tab)) 来复制和创建一个新矩阵

3）您可以优化您的 knn() 函数，该函数对同一向量进行 4 次排序

4) 为什么不只是 rdist(tab) ？

于 2014-03-12T10:06:51.227 回答
0

所以我已经为此工作了一段时间并进行了测试。对于遇到类似问题的其他人，这里有两个更优化的代码版本。我已经显着减少了计算时间，但是它仍然会因为太多的数据条目而崩溃。我的下一步是尝试使用 Rcpp 来实现这一点，如果可能的话，利用我可用的 12 个内核（最终目标是在合理的时间范围内计算 1-2 百万个条目）。不确定在任何一点上进行的最佳方式，但这是我的代码。感谢您的帮助！

##################################
##############Optimized code
t.m<-t(test_euclid_log)

knn_log <- function (vec,k) {
  sum(vec[1:k+1])
}
knn_log <- cmpfun(knn_log)

distf <- function(x,t.m) sqrt(colSums((x - t.m)^2))
distf <- cmpfun(distf)

myfunc <- function (tab) {
  rowsums<-numeric(nrow(tab))
  knnsums_log <- matrix(nrow=nrow(tab),ncol=4)
  for(i in 1:nrow(tab)) {
    q<-apply(tab[i,],1,distf,t.m=t.m)
    rowsums[i] <- colSums(q)
    q<-sort(q)
    for (kn in 1:4) {
      knnsums_log[i,kn] <- knn_log(q,kn)             
    }
  }
  return(cbind(rowsums,knnsums_log))
}
myfunc <- cmpfun(myfunc)
system.time(output <- myfunc(t))

我尝试使用 apply：

###############Vectorized
myfuncvec <- function (tab) {
  kn<-c(1:4)
  q<-apply(tab,1,distf,t.m=t.m)
  rowsums <- colSums(q)
  q<-sort(q)
  knnsums_log <- vapply(kn,knn_log,vec=q,FUN.VALUE=c(0))        
  return(c(rowsums,knnsums_log))
}
myfuncvec <- cmpfun(myfuncvec)

t1<-split(t,row(t))
system.time(out <- vapply(t1,myfuncvec,FUN.VALUE=c(0,0,0,0,0)))
out <- t(out)

作为参考，第一个代码似乎更快。

于 2014-04-04T08:29:20.297 回答