2011-04-06 87 views
20

我有一个NxM矩阵,我想计算M点之间的欧几里得距离矩阵。在我的问题中,N约为100,000。由于我打算将这个矩阵用于k-最近邻算法,我只需要保持最小距离,所以得到的矩阵非常稀疏。这与例如dist()的结果相反,这将导致密集的矩阵(并且对于我的尺寸N可能存在存储问题)。计算稀疏成对距离矩阵R

迄今为止我发现的kNN包(knnflexkknn等)都显示为使用密集矩阵。另外,Matrix包不提供成对距离功能。

接近我的目标,我看到spam包有一个nearest.dist()函数,允许人们只考虑小于某个阈值的距离,delta。然而,在我的情况下,特定值delta可能会产生太多距离(因此我必须密集存储密度矩阵)或距离太短(以至于我不能使用kNN)。

我已经见过以前的讨论,试图使用bigmemory/biganalytics软件包来执行k-means clustering,但在这种情况下似乎没有可以利用这些方法。

有没有人知道一个函数/实现将在R中以稀疏方式计算距离矩阵?我的(可怕的)备份计划是有两个for循环并将结果保存在Matrix对象中。

+0

只要确保...你知道'dist' http:// stat。 ethz.ch/R-manual/R-patched/library/stats/html/dist.html,对吗? – Benjamin 2011-04-06 17:08:21

+0

对不起,我不清楚为什么dist()不适合我的情况。它导致了一个稠密的矩阵,并且存储NxN矩阵有点烦人。 – 2011-04-07 01:10:41

+0

您应该或者接受其中一个答案,您认为它实际上回答了问题(如果您认为它最合适,那么是您自己的问题),或者编辑您的问题以澄清问题的原因。 – Tommy 2011-07-25 16:45:58

回答

6

好了,我们不能让你诉诸for循环,我们现在可以:)

当然有如何表示稀疏矩阵的问题。一个简单的方法是让它只包含最近点的索引(并根据需要重新计算)。但在下面的溶液中,我把二者的距离(“D1”等)和索引(“I1”等)在一个单一的矩阵:

sparseDist <- function(m, k) { 
    m <- t(m) 
    n <- ncol(m) 
    d <- vapply(seq_len(n-1L), function(i) { 
     d<-colSums((m[, seq(i+1L, n), drop=FALSE]-m[,i])^2) 
     o<-sort.list(d, na.last=NA, method='quick')[seq_len(k)] 
     c(sqrt(d[o]), o+i) 
     }, numeric(2*k) 
    ) 
    dimnames(d) <- list(c(paste('d', seq_len(k), sep=''), 
     paste('i', seq_len(k), sep='')), colnames(m)[-n]) 
    d 
} 

尝试出来9 2D点:

> m <- matrix(c(0,0, 1.1,0, 2,0, 0,1.2, 1.1,1.2, 2,1.2, 0,2, 1.1,2, 2,2), 
       9, byrow=TRUE, dimnames=list(letters[1:9], letters[24:25])) 
> print(dist(m), digits=2) 
    a b c d e f g h 
b 1.1        
c 2.0 0.9       
d 1.2 1.6 2.3      
e 1.6 1.2 1.5 1.1     
f 2.3 1.5 1.2 2.0 0.9    
g 2.0 2.3 2.8 0.8 1.4 2.2   
h 2.3 2.0 2.2 1.4 0.8 1.2 1.1  
i 2.8 2.2 2.0 2.2 1.2 0.8 2.0 0.9 
> print(sparseDist(m, 3), digits=2) 
    a b c d e f g h 
d1 1.1 0.9 1.2 0.8 0.8 0.8 1.1 0.9 
d2 1.2 1.2 1.5 1.1 0.9 1.2 2.0 NA 
d3 1.6 1.5 2.0 1.4 1.2 2.2 NA NA 
i1 2.0 3.0 6.0 7.0 8.0 9.0 8.0 9.0 
i2 4.0 5.0 5.0 5.0 6.0 8.0 9.0 NA 
i3 5.0 6.0 9.0 8.0 9.0 7.0 NA NA 

并试图解决更大的问题(10k点)。尽管如此,在100k点和更多维度上需要很长时间(比如15-30分钟)。

n<-1e4; m<-3; m=matrix(runif(n*m), n) 
system.time(d <- sparseDist(m, 3)) # 9 seconds on my machine... 

P.S.刚才注意到,当我写这篇文章时,你发布了一个答案:这里的解决方案大概是两倍的速度,因为它不会计算两次相同的距离(点1和点13之间的距离与点13和点1之间的距离相同)。

+0

感谢您的回答。我同意它快两倍。然而,对于我的应用(kNN),我认为只有距离矩阵的上三角实际上稍微不方便。我想我可以坚持我提交的代码的并行版本。不过谢谢你! – 2011-04-07 01:06:09

2

现在我使用以下内容,灵感来自this answer。输出是一个n x k矩阵,其中元素(i,k)是数据点的索引,即k最接近i

n <- 10 
d <- 3 
x <- matrix(rnorm(n * d), ncol = n) 

min.k.dists <- function(x,k=5) { 
    apply(x,2,function(r) { 
    b <- colSums((x - r)^2) 
    o <- order(b) 
    o[1:k] 
    }) 
} 

min.k.dists(x) # first row should be 1:ncol(x); these points have distance 0 
dist(t(x))  # can check answer against this 

如果是因为担心关系是如何被处理和诸如此类的东西,也许rank()应纳入。

上面的代码似乎有点快,但我相信它可以改进(虽然我没有时间去Cfortran路线)。所以我仍然愿意快速和稀疏地实施上述。

下面我包括我最终使用并行版本:

min.k.dists <- function(x,k=5,cores=1) { 
    require(multicore) 
    xx <- as.list(as.data.frame(x)) 
    names(xx) <- c() 
    m <- mclapply(xx,function(r) { 
    b <- colSums((x - r)^2) 
    o <- order(b) 
    o[1:k] 
    },mc.cores=cores) 
    t(do.call(rbind,m)) 
} 
+0

你需要做dist(t(x))来获得可比的答案。 – Tommy 2011-04-06 16:44:57

1

如果您想保留min.k.dist函数的逻辑并返回重复的距离,您可能需要考虑修改它。用0距离返回第一条线似乎毫无意义,对吧? ...并通过在我的其他答案中加入一些技巧,你可以加快你的版本30%:

min.k.dists2 <- function(x, k=4L) { 
    k <- max(2L, k + 1L) 
    apply(x, 2, function(r) { 
    sort.list(colSums((x - r)^2), na.last=NA, method='quick')[2:k] 
    }) 
} 

> n<-1e4; m<-3; m=matrix(runif(n*m), n) 
> system.time(d <- min.k.dists(t(m), 4)) #To get 3 nearest neighbours and itself 
    user system elapsed 
    17.26 0.00 17.30 
> system.time(d <- min.k.dists2(t(m), 3)) #To get 3 nearest neighbours 
    user system elapsed 
    12.7  0.0 12.7