4

我有一个数据框，它是一系列向量的开始和结束时间。所以我们有一堆 x 向量和 y 向量，我想比较两个向量之间的最小距离。如果两个向量有任何重叠部分，则最小距离为 0（在此应用程序中，您不能有负距离）。

这是数据框的样子（下面是获取它的简单方法）：

  x.start x.end y.start y.end
1       3     6       7     8
2      10    14      19    22
3      19    25      45    45
4      33    33      66    68
5     100   101      90   101
6     130   150     134   153

所以我想在 x 向量上逐行进行，并将每个 x 向量与所有 y 向量进行比较，并找到两者之间的最小距离。

下面我用一个嵌套for循环来完成这个，但是我需要用更多的向量重复这个很多次，所以速度很重要。这很慢。完成这项任务的最有效方法是什么？

期望的输出：

## > out
## [1]  1  2  0 11  0  0

我更愿意将其保留在基础 R 中，但如果您有更快的独立于操作系统的方式，我会开放。

数据：

dat <- data.frame(
    x.start = c(3, 10, 19, 33, 100, 130),
    x.end = c(6, 14, 25, 33, 101, 150), 
    y.start = c(7, 19, 45, 66, 90, 134),
    y.end = c(8, 22, 45, 68, 101, 153)
)

请注意，在下面查看我的答案可能会更好地理解该任务。在一些竞争对手上升后，我将对结果进行基准测试。

这是作为数据框的所需输出，以便于比较和理解：

  min_dist x.start x.end y.start y.end
1        1       3     6       7     8
2        2      10    14      19    22
3        0      19    25      45    45
4       11      33    33      66    68
5        0     100   101      90   101
6        0     130   150     134   153

2组向量的可视化：

在此处输入图像描述

所以我想知道每个红色段到最近的 y 向量（蓝色段）的最小距离；虽然我看到 x 向量 33:33 和 y 向量 45:45 没有出现，但我认为这可以直观地描述问题。

基准测试结果：运行 Tally

Unit: microseconds
                 expr      min       lq   median       uq        max neval
         GEEKTRADER() 5386.186 5553.659 5603.341 5678.214  68297.171  5000
            TRINKER() 1421.887 1480.198 1496.992 1517.985  63619.596  5000
       RICARDO_OPT1() 4748.483 4892.631 4974.968 5110.952 156400.446  5000
       RICARDO_OPT2() 7387.463 7583.859 7694.418 7845.564  70200.949  5000
          FOTNELTON()  437.576  462.767  473.963  486.091   6109.724  5000
     FOTNELTON_EDIT()  356.871  379.730  390.460  402.122   3576.174  5000
 RICARDO_SIMPLE_ANS()  801.444  842.496  855.091  870.952   3923.715  5000
             ALEXIS()  343.343  385.328  397.923  408.652   4169.093  5000
4

6 回答 6

5

我认为最简单且可能最快的方法如下：

apply(dat, 1, function(d) {
  overlap <- (dat$y.end >= d[1] & dat$y.end <= d[2]) |
             (dat$y.start >= d[1] & dat$y.start <= d[2])
  if (any(overlap)) 0
  else min(abs(c(d[1] - dat$y.end[!overlap], dat$y.start[!overlap] - d[2])))
})

编辑： overlap可以更简单：

apply(dat, 1, function(d) {
  overlap <- dat$y.end >= d[1] & dat$y.start <= d[2]
  if (any(overlap)) 0
  else min(abs(c(d[1] - dat$y.end[!overlap], dat$y.start[!overlap] - d[2])))
})
于 2013-10-29T05:43:09.393 回答
1

不确定这是否最快。但这是一种方法。

apply(dat[,1:2], MARGIN=1, FUN=function(x) {
  min(apply(dat[,3:4], MARGIN = 1, FUN = function(y){
    X <- c(t(x))
    Y <- c(t(y))
    #Check if the two line segments overlap else find minimum distance between the 2 edges of each line segments
    if (diff(range(c(X,Y))) <=  diff(X) + diff(Y)){
      return(0)
    } else {
      return(min(abs(outer(Y, X, "-"))))
    }
  }))
})
## [1]  1  2  0 11  0  0
于 2013-10-29T05:12:15.317 回答
1

这是一个更简单的解决方案（相对于我之前的答案），基于数据长而不宽的事实：

current <- c("x.start", "x.end")
comparedto <- c("y.start", "y.end")

apply(dat[, current], 1, function(r) {
  max(0, min(ifelse(r[[1]] > dat[, comparedto[[1]]], r[[1]]-dat[, comparedto[[2]]], dat[, comparedto[[1]]]-r[[2]])))
})
# [1]  1  2  0 11  0  0
于 2013-10-29T05:57:19.643 回答
1

受上述所有启发（并希望我没有误解 OP）：

alexis3 <- function()
{                   
 fun <- function(x1, x2, yvec1 = dat$y.start, yvec2 = dat$y.end) 
 { 
  if(any(c(yvec1, yvec2) %in% seq(x1, x2))) return(0)
  else min(abs(outer(c(x1, x2), c(yvec1, yvec2), `-`))) 
 } 

 mapply(fun, x1 = dat$x.start, x2 = dat$x.end)
}

#> alexis3()
#[1]  1  2  0 11  0  0
于 2013-10-29T11:36:25.947 回答
1

下面两个选项。两者都使用。不太简洁的选项（＃2），我相信会更快。我有兴趣查看基准。

by=另外，请注意语句下方的注释。从您的示例数据来看，每个x.start值似乎都有一个唯一x.end值。如果是这种情况，则无需x.end在by声明中包含。否则，请更正该部分。

  library(data.table)
  DT <- data.table(dummykey = "A", dat, key="dummykey")
  A <- DT[ , !c("y.start", "y.end"), with=FALSE][DT[, !c("x.start", "x.end"), with=FALSE], allow.cartesian=TRUE]

选项1

  A[, max(0, min(ifelse(x.start > y.start, x.start-y.end, y.start-x.end))), by=x.start]
                                                 # or by=list(x.start, y.end)

选项 2

  A[, xstartGTystart := x.start > y.start]
  A[(xstartGTystart), candidates := x.start - y.end]
  A[!(xstartGTystart), candidates := y.start-x.end]

  A[, list(minDisance=max(0, min(candidates))), by=x.start]
                             # or by=list(x.start, y.end)
于 2013-10-29T05:32:14.370 回答
0

嵌套的 for 循环答案：

## Convert start and end times to two lists of vectors
xvects <- mapply(":", dat[, 1], dat[, 2])
yvects <- mapply(":", dat[, 3], dat[, 4])

## Function to take vector x[i] and compare to all vector y    
FUN <- function(a, b) {
    vals <- abs(outer(a, b, "-"))
    if ((sum(vals) == 0) > 0) {
        return(0)
    }
    min(vals)
}

## Pre alot
out <- rep(NA, nrow(dat))

## Nested for loop
for (i in seq_along(xvects)) {

    outj <- rep(NA, nrow(dat))

    for (j in seq_along(yvects)) {

        outj[j] <- FUN(xvects[[i]], yvects[[j]])
    }

    out[i] <- min(outj)

}
于 2013-10-29T04:23:10.673 回答