2 个逻辑向量的元素之间的快速最小距离（间隔）（取 2）答案

【问题标题】：Fast minimum distance (interval) between elements of 2 logical vectors (take 2)2 个逻辑向量的元素之间的快速最小距离（间隔）（取 2）
【发布时间】：2014-02-01 15:10:28
【问题描述】：

我问了一个相关的问题here，但我意识到我在计算这个复杂的度量时花费了太多时间（目标是与随机测试一起使用，所以速度是一个问题）。所以我决定放弃加权，只使用两个度量之间的最小距离。所以这里我有 2 个向量（在一个数据框中用于演示目的，但实际上它们是两个向量。

       x     y
1  FALSE  TRUE
2  FALSE FALSE
3   TRUE FALSE
4  FALSE FALSE
5  FALSE  TRUE
6  FALSE FALSE
7  FALSE FALSE
8   TRUE FALSE
9  FALSE  TRUE
10  TRUE  TRUE
11 FALSE FALSE
12 FALSE FALSE
13 FALSE FALSE
14 FALSE  TRUE
15  TRUE FALSE
16 FALSE FALSE
17  TRUE  TRUE
18 FALSE  TRUE
19 FALSE FALSE
20 FALSE  TRUE
21 FALSE FALSE
22 FALSE FALSE
23 FALSE FALSE
24 FALSE FALSE
25  TRUE FALSE

在这里，我编写了一些代码来找到最小距离，但我需要更快的速度（删除不必要的调用和更好的矢量化）。也许我不能在基础 R 中走得更快。

## MWE EXAMPLE: THE DATA
x <- y <- rep(FALSE, 25)
x[c(3, 8, 10, 15, 17, 25)] <- TRUE
y[c(1, 5, 9, 10, 14, 17, 18, 20)] <- TRUE

## Code to Find Distances
xw <- which(x)
yw <- which(y)

min_dist <- function(xw, yw) {
    unlist(lapply(xw, function(x) {
        min(abs(x - yw))
    }))
}

min_dist(xw, yw)

有什么方法可以提高基础 R 的性能吗？使用dplyr 或data.table？

我的向量更长（10,000 + 个元素）。

编辑每个弗洛德尔的替补席。我在 MWE 中预料到了一个问题，我也不知道如何解决它。如果任何 x 位置小于最小 y 位置，就会出现问题。

x <- y <- rep(FALSE, 25)
x[c(3, 8, 9, 15, 17, 25)] <- TRUE
y[c(5, 9, 10, 13, 15, 17, 19)] <- TRUE


xw <- which(x)
yw <- which(y)

flodel <- function(xw, yw) {
   i <- findInterval(xw, yw)
   pmin(xw - yw[i], yw[i+1L] - xw, na.rm = TRUE)
}

flodel(xw, yw)

## [1] -2 -1 -6 -2 -2 20
## Warning message:
## In xw - yw[i] :
##   longer object length is not a multiple of shorter object length

【问题讨论】：

标签： r performance vector

【解决方案1】：

flodel <- function(x, y) {
  xw <- which(x)
  yw <- which(y)
  i <- findInterval(xw, yw, all.inside = TRUE)
  pmin(abs(xw - yw[i]), abs(xw - yw[i+1L]), na.rm = TRUE)
}

GG1 <- function(x, y) {
  require(zoo)
  yy <- ifelse(y, TRUE, NA) * seq_along(y)
  fwd <- na.locf(yy, fromLast = FALSE)[x]
  bck <- na.locf(yy, fromLast = TRUE)[x]
  wx <- which(x)
  pmin(wx - fwd, bck - wx, na.rm = TRUE)
}

GG2 <- function(x, y) {
  require(data.table)
  dtx <- data.table(x = which(x))
  dty <- data.table(y = which(y), key = "y")
  dty[dtx, abs(x - y), roll = "nearest"] 
}

样本数据：

x <- y <- rep(FALSE, 25)
x[c(3, 8, 10, 15, 17, 25)] <- TRUE
y[c(1, 5, 9, 10, 14, 17, 18, 20)] <- TRUE

X <- rep(x, 100)
Y <- rep(y, 100)

单元测试：

identical(flodel(X, Y), GG1(X, Y))
# [1] TRUE

基准测试：

library(microbenchmark)
microbenchmark(flodel(X,Y), GG1(X,Y), GG2(X,Y))
# Unit: microseconds
#          expr       min         lq     median        uq        max neval
#  flodel(X, Y)   115.546   131.8085   168.2705   189.069   1980.316   100
#     GG1(X, Y)  2568.045  2828.4155  3009.2920  3376.742  63870.137   100
#     GG2(X, Y) 22210.708 22977.7340 24695.7225 28249.410 172074.881   100

[由 Matt Dowle 编辑] 24695 微秒 = 0.024 秒。基于微量数据的微基准所做的推断很少能保持有意义的数据大小。

[由 flodel 编辑] 我的向量长度为 2500，考虑到 Tyler 的声明（10k），这相当有意义，但是很好，让我们尝试使用长度为 2.5e7 的向量。我希望你能原谅我在这种情况下使用system.time：

X <- rep(x, 1e6)
Y <- rep(y, 1e6)
system.time(flodel(X,Y))
#    user  system elapsed 
#   0.694   0.205   0.899 
system.time(GG1(X,Y))
#    user  system elapsed 
#  31.250  16.496 112.967 
system.time(GG2(X,Y))
# Error in `[.data.table`(dty, dtx, abs(x - y), roll = "nearest") : 
#   negative length vectors are not allowed

[从 Arun 编辑] - 使用 1.8.11 的 2.5e7 基准测试：
[来自 Arun 的编辑 2] - 在 Matt 最近的 faster 二分搜索/合并之后更新时间安排

require(data.table)
arun <- function(x, y) {
    dtx <- data.table(x=which(x))
    setattr(dtx, 'sorted', 'x')
    dty <- data.table(y=which(y))
    setattr(dty, 'sorted', 'y')
    dty[, y1 := y]
    dty[dtx, roll="nearest"][, abs(y-y1)]
}

# minimum of three consecutive runs
system.time(ans1 <- arun(X,Y))
#   user  system elapsed 
#  1.036   0.138   1.192 

# minimum of three consecutive runs
system.time(ans2 <- flodel(X,Y))
#   user  system elapsed 
#  0.983   0.197   1.221 

identical(ans1, ans2) # [1] TRUE

【讨论】：

MWE 没有解决一个问题。我将编辑放入我的解决方案中，但您的方法要快得多，我不想放弃它。
我想我修好了，试试看。
确实如此。谢谢你。我也得到了all.inside = TRUE 现在所做的事情。感谢您向我介绍新功能。
@Tyler Rinker，你能用 10,000 大小的数据集发布相应的时间吗？
@G.Grothendieck 是的，但我需要几天时间才能找到它并对其进行基准测试。

【解决方案2】：

这里有两个解决方案。既不使用循环也不使用应用函数。

1) 第一个与我在prior question 上发布的解决方案相同，如果z 为 1，除了这里的简化假设允许我们稍微缩短它，我们已经减少了答案相对于那个 1。

library(zoo)

yy <- ifelse(y, TRUE, NA) * seq_along(y)
fwd <- na.locf(yy, fromLast = FALSE)[x]
bck <- na.locf(yy, fromLast = TRUE)[x]
wx <- which(x)
pmin(wx - fwd, bck - wx, na.rm = TRUE)

2) 第二个是data.table解决方案。 data.table 可以采用 roll="nearest" 参数，这似乎正是您所需要的：

library(data.table)

dtx <- data.table(x = which(x))
dty <- data.table(y = which(y), key = "y")
dty[dtx, abs(x - y), roll = "nearest"]

我不确定这是否重要，但我使用的是 data.table 版本 1.8.11（CRAN 版本目前是 1.8.10）。

【讨论】：