計算R中的稀疏成對距離矩陣

Question

我有一個NxM矩陣，我想計算M點之間的歐幾里德距離的NxN矩陣。 在我的問題中， N大約是100,000。 由於我計划將此矩陣用於k近鄰算法，我只需要保持k最小距離，因此得到的NxN矩陣非常稀疏。 這與dist()結果形成對比，例如，這將導致密集的矩陣（並且可能存在我的尺寸N存儲問題）。

我到目前為止找到的kNN包（ knnflex ， kknn等）似乎都使用密集矩陣。 此外， Matrix包不提供成對距離功能。

更接近我的目標，我發現spam包有一個nearest.dist()函數，允許人們只考慮小於某個閾值的距離delta 。 然而，在我的情況下， delta的特定值可能會產生太多的距離（因此我必須密集存儲NxN矩陣）或距離太遠（因此我不能使用kNN）。

我之前已經看到過嘗試使用bigmemory/biganalytics包執行k-means聚類的bigmemory/biganalytics ，但在這種情況下我似乎不能利用這些方法。

有人知道在R中以稀疏方式計算距離矩陣的函數/實現嗎？ 我的（可怕的）備份計划是有兩個for循環並將結果保存在Matrix對象中。

Answer 1

好吧，我們不能讓你訴諸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...

PS剛剛注意到你在我寫這篇文章時發布了一個答案：這里的解決方案速度大約是其兩倍，因為它不會計算兩次相同的距離（點1和13之間的距離與點13和1之間的距離相同） 。

Answer 2

現在我使用以下內容，靈感來自這個答案 。 輸出是nxk矩陣，其中元素(i,k)是最靠近i第k個數據點的索引。

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()納入其中。

上面的代碼似乎有點快，但我確信它可以改進（雖然我沒有時間去C或fortran路線）。 所以我仍然對上面的快速和稀疏實現持開放態度。

下面我添加了一個我最終使用的並行版本：

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))
}

Answer 3

如果您想保留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