R提高嵌套for()循环的效率,以便在大型数据集中进行简单的距离计算

时间:2018-04-16 04:24:32

标签: r for-loop lapply

我有两组点(带x,y,z坐标)数据dtmT(113k观测值)和ptmT(200k观测值)。对于dtmT中的每个点,我都希望计算到ptmT中某点的最短距离。我对R来说很新,没有其他编程背景,所以我已经嵌套了循环,因此对于每个dtmT点,它计算该点与ptmT中每个点之间的距离,并将其存储在矩阵(ptmTDistM)。后循环我使用apply将矩阵中每列的最小值作为向量,然后使用cbind将其附加回dtmT,以便最终乘积为dtmT,其中x,y,z,Dist代表可能的最短距离dtmT指向ptmT内的任何点。这适用于5个观测值,最高可达500个,但是当我尝试使用5,000时,它会挂起,完整数据集在dtmT中为113K观测值,在ptmT中为200k观测值。我最初使用数据框编程,但已阅读一些问题和答案,这些问题和答案使我尝试使用矩阵。我也明白使用向量和lapply组是最好的,我不知道如何将嵌套for循环转换为lapply组,特别是因为索引对于我如何获得它非常重要现在。我也看过Dist()但是不确定如何应用它来获得我需要的东西。

提供了每个数据集的前5个观察结果以及我迄今为止所做的工作。

非常感谢您的帮助!

#first 5 observations of ptmT dataset
ptmT <- c(621019.2, 621024.2, 621023.7, 621018.3, 621019.2, 2701229.1, 
2701231.2, 2701231.9, 2701230.2, 2701229.1, 2071.5, 2080.0, 2080.0, 2071.5, 
2071.5)
dim(ptmT) <- c(5,3)
colnames(ptmT) <- c("XP", "YP", "ZP")

#first 5 observations of dtmT dataset
dtmT <- c( 621757.360, 621757.360, 621757.419, 621757.536, 
621757.540,2701071.810, 2701071.810, 2701071.814, 2701071.843, 2701071.844, 
2089.210, 2088.110, 2070.435, 2053.536, 2052.951)
dim(dtmT) <- c(5,3)
colnames(dtmT) <- c("X", "Y", "Z")

dtmTDist <- 0
ptmTDist <- 0
ptmTDistM <- matrix(data = NA, nrow = length(ptmT[,1]), ncol = 
length(dtmT[,1]))

require (svMisc)
for (row in 1:nrow(dtmT))   {
    progress(row)               
    X <- dtmT[row, "X"]
    Y <- dtmT[row, "Y"]
    Z <- dtmT[row, "Z"]

        for (i in 1:nrow(ptmT)) {
            X2 <- ptmT[i, "XP"]
            Y2 <- ptmT[i, "YP"]
            Z2 <- ptmT[i, "ZP"]

            D <- sqrt((X - X2)^2 + (Y - Y2)^2 + (Z - Z2)^2)
            ptmTDistM[i,row] <- D
            }
    }
Dist <- apply(ptmTDistM, 2, min)
dtmT2 <- cbind(dtmT,Dist)

4 个答案:

答案 0 :(得分:1)

你可以使用最近的邻居来搜索https://github.com/jefferis/RANN这样的包,这些包将为每个查询点返回最近的点以及它与参考点的距离(使用有效的空间索引)

P <- 200000
ptmT <- data.frame(x=runif(P),y=runif(P),z=runif(P))
D <- 113000
dtmT <- data.frame(x=runif(D),y=runif(D),z=runif(D))
library(RANN)
res <- nn2(ptmT,dtmT,1)

答案 1 :(得分:0)

通过利用R的矢量算法等功能,您可以获得一些性能提升。但是,任何需要检查集合A中的每个点与集合B中的每个点的方法都将变得非常苛刻,因为两个集合变得很大,因为要进行的比较的数量与O(m * n)成比例,其中m和n是大小两套。

有时可以解决这个问题的一个技巧是按地理位置对您的设置进行分块,并使用该分块来确定您实际测试的对。

例如,在2D中:

  • 从A中随机选取100个点。对于每个点,通过与B中的每个点进行比较,找到距离B中最近邻居的距离。(总计:100 * n比较。)
  • 设h =上面的最大值。
  • 将您的空间划分为块,大小为2h x 2h。对于A中的任何一点,您可以几乎确定它在B中的最近邻居将位于其自己的块中,或者位于8个相邻块中的一个中。
  • 对于B中的每个点,确定它所在的块,并设置索引或向量列表,以便您可以轻松引用“B中位于块[x,y]中的所有点”。
  • 对于A中的每个点P,找到它所在的块,并注意距离该块的最近边界有多远(称为d),然后针对B中位于同一块中的所有点进行测试。 (这些是你可以利用矢量运算的地方。)
  • 如果你发现B中的一个点接近或等于d,那么这绝对是最近的邻居,你可以停下来。
  • 否则,如果您找到的最近点不是d,或者您的搜索区域中B没有任何点,请将搜索范围扩展到相邻块,然后设置d&lt; -d + 2h。
  • 重复直到找到最近的点,然后转到下一个P直到完成。

这意味着对于A中的每个点,您只是针对B中的少量附近点进行测试,而不是测试地图上的所有内容。即使搜索方法更复杂,对于大型的m&amp;你应该看到更好的搜索时间。

如果您的数据点分布非常不均匀,则可能需要使用网格形状;理想情况下,“块”的设计使得每个块只包含几个B成员。

此外,小型经济:请注意,最小化距离平方也会使距离最小化。因此,不是找到min(dist),而是可以执行sqrt(min(dist ^ 2)),这将为您节省大量的平方根运算,这是值得的。

答案 2 :(得分:0)

由于我们无法避免计算两点之间的距离,(除非之前计算过完全相同的点对),你肯定必须进行113,000 * 200,000次计算。

加速这种做法的唯一方法是尽量使计算尽可能平行。

你一定要试试评论中建议的并行软件包。

这是我在R中使用apply函数的解决方案,它尝试尽可能地进行矢量化和计算。

#Function to calculate Euclidean distance. We can simply use matrix algebra here.
computeDistance <- function(P,Q){
  D <- sqrt(sum((P-Q)^2))
  return(D)
}

#We use one apply row-wise on dtmT and for compute distance with each row in ptmT.
#Since this is a perfectlly parallel process, apply will be substantially faster than a for loop
distMat <- apply(dtmT, MARGIN = 1, function(p){apply(ptmT,MARGIN = 1,FUN = function(q){computeDistance(p,q)})})

#Calculate minimum of each column to get the minimum distance
minDist <- apply(distMat,2,min)

#Attach to dtmT
dtmTFinal <- cbind(dtmT,"Minimum_Distance" = minDist)

我在5000 * 5000的情况下尝试了这个,并且在平均笔记本电脑上花了大约一分钟。

希望这有帮助。

答案 3 :(得分:0)

这里的一个主要问题是内存,因为你的113k x 200k矩阵将需要大约170 GB的内存。但是,您永远不需要完整的矩阵。相反,您只需要每行的最小值。此外,您可以以矢量化方式计算此最小值,只留下一个循环:

Dist <- vector(length = nrow(dtmT), mode = "numeric")
for (row in 1:nrow(dtmT))   {
  X <- dtmT[row, "X"]
  Y <- dtmT[row, "Y"]
  Z <- dtmT[row, "Z"]

  Dist[row] <- sqrt(min((X - ptmT[ ,"XP"])^2 + (Y - ptmT[ ,"YP"])^2 + (Z - ptmT[ , "ZP"])^2))
}
cbind(dtmT,Dist)

现在这个循环是“令人尴尬的并行”,你可以使用foreach进行平行:

library(foreach)
library(doParallel)
registerDoParallel(cores = 4)
Dist <- foreach (row = 1:nrow(dtmT), .combine = c) %dopar% {
  X <- dtmT[row, "X"]
  Y <- dtmT[row, "Y"]
  Z <- dtmT[row, "Z"]

  sqrt(min((X - ptmT[ ,"XP"])^2 + (Y - ptmT[ ,"YP"])^2 + (Z - ptmT[ , "ZP"])^2))  
}
cbind(dtmT,Dist)

使用for循环的替代方法将适用。将其与更紧凑的符号结合起来我们得到:

apply(dtmT, 1, function(x) sqrt(min(colSums((x-t(ptmT))^2))))

同样,apply可以轻松并行化。将其应用于尺寸小10倍的问题可以在双核机器上实现:

library(parallel)
cl <- makeForkCluster(2)
dtmT <- matrix(runif(3 * 11300), ncol = 3)
ptmT <- matrix(runif(3 * 200000), ncol = 3)
system.time(Dist <- parApply(cl, dtmT, 1, function(x) sqrt(min(colSums((x-t(ptmT))^2)))))
#>        User      System verstrichen 
#>       0.021       0.004      34.474
head(cbind(dtmT, Dist))
#>                                            res
#> [1,] 0.9111543 0.5971182 0.8725145 0.010714792
#> [2,] 0.4893960 0.3321890 0.7440035 0.008545801
#> [3,] 0.3637524 0.6051168 0.7955850 0.003792442
#> [4,] 0.6684364 0.1819622 0.2487011 0.017937629
#> [5,] 0.6761877 0.1731773 0.3214378 0.011912805
#> [6,] 0.8060648 0.7789117 0.1673685 0.012680877