r - 给定一个 (x,y) 对，如何选择最接近的 (x,y)_i 对 - R

Question

我有一个数据框(称为 coors)，其中包含一个 x 坐标向量和一个 y 坐标向量。

我有另一个数据框(称为 pickedPoint)，其中包含感兴趣的指定 (x,y) 对。

目标是将每个 coors 点与其最近的 pickedPoint 相关联。我想使用 Euclidean norm (l-2)。如果可能的话，请您使用 tidyverse 方法。

       Coor = data.frame(row = rep(1:96, each = 72),
                         col = rep(1:72, times = 96))

       PickedPoint = data.frame(ppRow = sample(96,10),
                                ppCol = sample(72,10)) 

还有一个类似的线程是用python发布的:

How to find the closest (x, y) position to (x,y) position in another list?

到目前为止，我已经包含了一个基准答案:

microbenchmark(CPak(), latemail(),Jul(), times=10L)
Unit: milliseconds
expr       min         lq       mean     median         uq       max neval
CPak()  37.83691   38.60585  43.66030   39.86094   44.9592     62.784 10
latemail() 4275.10 4536.783   4674.966   4712.938  4855.860   5045.069 10
Jul()   37.38809   39.87625   46.17202   44.90693   53.08938    57.33  10

Answer 1

我经常处理这类问题。

您最好避免使用 tidyverse 答案并使用矢量化方法。我喜欢用 outer在这种情况下，速度很快。我将距离计算为 Dist = sqrt((x1-x2)^2 + (y1-y2)^2) .

myfun <- function() {
    Dx <- outer(Coor$row, PickedPoint$ppRow, "-")**2  # ** is same as ^
    Dy <- outer(Coor$col, PickedPoint$ppCol, "-")**2
    Dist <- sqrt(Dx+Dy)
    minDistind <- apply(Dist, 1, which.min)
    ans <- PickedPoint[minDistind,]
}

输出(头部)

    ppRow ppCol
8      10    32
8.1    10    32
8.2    10    32
8.3    10    32
8.4    10    32
8.5    10    32

我只是为了完整性而与其他答案进行比较

latemail <- function() {
    closest <- sapply( 1:nrow(Coor), function(x) which.min(sqrt(rowSums(sweep(PickedPoint, MARGIN=1, STATS=unlist(Coor[x,]))^2))) )
}

注意 我添加了sol <- PickedPoint[Coor$closest,]到 Jul 的函数，因为原始函数只返回索引

Jul <- function() {
    require(sp)
    require(dplyr)
    Coor$closest <- spDists(as.matrix(Coor),as.matrix(PickedPoint)) %>% apply(1,which.min)
    sol <- PickedPoint[Coor$closest,]
}

基准测试

library(microbenchmark)
microbenchmark(myfun(), latemail(), times=10L)

       expr        min         lq       mean     median         uq         max neval
    myfun()   50.34484   50.93591   53.75279   51.46284   55.46526    66.09656    10
 latemail() 9683.82227 9733.03489 9863.94716 9856.65472 9974.46137 10065.89549    10

microbenchmark(myfun(), Jul(), times=10L)

Unit: milliseconds
    expr      min       lq     mean   median       uq       max neval
 myfun() 47.85368 50.13398 63.84994 50.82162 58.62493 167.69221    10
   Jul() 54.27473 54.38482 59.22976 58.56265 61.97588  69.11861    10   

这说明了为什么您应该避免使用比 sapply 还要慢的 tidyverse 方法

请注意，此答案比较所有，如果您不使用简单的玩具示例，这可能很重要；对于您的玩具示例，您可以使用巧妙的技巧来避免全部比较