我有一个NxM
矩阵,我想计算NxN
点之间欧氏距离的M
矩阵。在我的问题中,N
大约是100,000。由于我打算将此矩阵用于k近邻算法,我只需保持k
最小距离,因此生成的NxN
矩阵非常稀疏。这与dist()
的结果形成对比,例如,这将导致密集矩阵(并且可能存在我的大小N
的存储问题。)
我到目前为止找到的kNN包(knnflex
,kknn
等)似乎都使用密集矩阵。此外,Matrix
包不提供成对距离函数。
更接近我的目标,我发现spam
包具有nearest.dist()
功能,允许人们只考虑小于某个阈值的距离delta
。但是,在我的情况下,delta
的特定值可能产生太多距离(因此我必须密集地存储NxN
矩阵)或距离太远(因此我不能使用kNN)
我之前已经看过尝试使用bigmemory/biganalytics
软件包执行k-means clustering的讨论,但在这种情况下我似乎无法利用这些方法。
有人知道在R中以稀疏方式计算距离矩阵的函数/实现吗?我的(可怕的)备份计划是有两个for
循环并将结果保存在Matrix
对象中。
答案 0 :(得分:7)
好吧,我们不能让你诉诸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个2分上尝试:
> 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之间的距离相同)。
答案 1 :(得分: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()
。
上面的代码似乎有点快,但我确信它可以改进(虽然我没有时间去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))
}
答案 2 :(得分: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