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

【问题标题】：Give an (x,y) pair, how to choose which (x,y)_i pair is the closest - R给一个 (x,y) 对，如何选择最接近的 (x,y)_i 对 - R
【发布时间】：2017-09-14 00:43:37
【问题描述】：

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

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

目标是将每个coors 点与其最近的pickPoint 相关联。我想使用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

【问题讨论】：

标签： r dataframe coordinates computational-geometry tidyverse

【解决方案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))) )
}

注意我在 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 方法

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

【讨论】：

【解决方案2】：

我建议为此使用 sp 包

library(sp)
library(dplyr)

Coor$closest <- spDists(as.matrix(Coor),as.matrix(PickedPoint)) %>% apply(1,which.min)

【讨论】：

很高兴知道这个包存在