r - 给出(x，y)对，如何选择最接近的(x，y)_i对-R

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

我有另一个数据框（称为PickedPoint），其中包含感兴趣的指定（x，y）对。

目标是将每个coors点关联到最近的PickedPoint。我想使用Euclidean norm (l-2)。如果可能的话，请您整理方法。

       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

最佳答案

我经常研究这种问题。

最好避免使用整洁的答案，而使用矢量化方法。在这种情况下，我喜欢使用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))) )
}

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

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方法

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