Question

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

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

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

Answer 1

我经常处理这类问题。

你最好避免一个整齐的答案并使用矢量化的方法。我喜欢在这种情况下使用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方法

请注意，这个答案会比较一切，如果您没有使用简单的玩具示例，这可能很重要;以你的玩具为例，你可以使用聪明的技巧来避免所有的比较

Answer 2

我建议使用sp包

library(sp)
library(dplyr)

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

给（x，y）对，如何选择哪个（x，y）_i对是最接近的 - R

2 个答案: