更快地找到一个向量与另一个向量的元素最近的日期

Faster way of find the closest dates of a vector to an element of another vector

我有几个不同大小的时间向量和一个二次采样的时间向量。

我试图找到最接近元素 $i^{th}$ 的点,但这种方法非常慢。

    for (i in 1:length(SamplingTime)){
which.min(abs(SamplingTime[i]-rTime1))
}

另外我想知道是否有人知道如何找到最接近 SamplingTime 的 i 元素的两个数据点。我最初的方法是将 posix 格式转换为数字格式并使用 RANN 包:

closest <- nn2(data=mytimes, k=2)[[1]]

但还是慢了。

编辑:

    SampleTime                        rTime

2018-06-01 00:51:40   UTC    2018-06-01 00:51:37 UTC 
2018-06-01 00:51:41,2 UTC    2018-06-01 00:51:38 UTC 
2018-06-01 00:51:41,4 UTC    2018-06-01 00:51:39 UTC
2018-06-01 00:51:41,5 UTC    2018-06-01 00:51:40 UTC 
2018-06-01 00:51:41,9 UTC    2018-06-01 00:51:41 UTC 
2018-06-01 00:51:43   UTC    2018-06-01 00:51:42 UTC
2018-06-01 00:51:46   UTC    2018-06-01 00:51:43 UTC
2018-06-01 00:51:48   UTC            .
          .                          .
          .

我的想法是,每次我都必须评估 rTime 的两个值中哪一个更接近 SampleTime[i]。例如,对于 SampleTime [3]=2018-06-01 00:51:48 UTC,更接近的 rTime 将是 rTime[4]=2018-06-01 00:51:40 UTC 和 rTime[5]=2018-06- 01 00:51:41 协调世界时

发布的问题实际上包含两个问题。第一个要求一种更快的方法来为 SampleTime.

中给出的每个值找到 rTime 中最接近的值

OP 的 for 循环“打印”rTime 中最接近值的索引。 (好吧,实际上 OP returns nothing 的代码片段没有 print() 语句或存储值。)

下面的代码 return 使用 滚动连接到最近的 的索引,data.table 包提供。

# reproduce OP's data
SampleTime <- 
  structure(c(1527814300, 1527814301.2, 1527814301.4, 1527814301.5, 
              1527814301.9, 1527814303, 1527814306, 1527814308), 
            class = c("POSIXct", "POSIXt"), tzone = "UTC")
rTime <- 
  structure(c(1527814297, 1527814298, 1527814299, 1527814300, 1527814301, 
              1527814302, 1527814303), 
            class = c("POSIXct", "POSIXt"), tzone = "UTC")

library(data.table)
sDT <- data.table(SampleTime)
rDT <- data.table(rTime)
# rolling join to nearest
rDT[sDT, on = .(rTime = SampleTime), roll = "nearest", which = TRUE]
[1] 4 5 5 5 6 7 7 7

如果需要值而不是索引:

sDT[, rTime := rDT[sDT, on = .(rTime = SampleTime), roll = "nearest", x.rTime]][]
            SampleTime               rTime
1: 2018-06-01 00:51:40 2018-06-01 00:51:40
2: 2018-06-01 00:51:41 2018-06-01 00:51:41
3: 2018-06-01 00:51:41 2018-06-01 00:51:41
4: 2018-06-01 00:51:41 2018-06-01 00:51:41
5: 2018-06-01 00:51:41 2018-06-01 00:51:42
6: 2018-06-01 00:51:43 2018-06-01 00:51:43
7: 2018-06-01 00:51:46 2018-06-01 00:51:43
8: 2018-06-01 00:51:48 2018-06-01 00:51:43

请注意,在打印 POSIXct 对象时,小数秒和时区信息在默认情况下会被忽略。要显示两者,需要指定格式:

sDT[, rTime := rDT[sDT, on = .(rTime = SampleTime), roll = "nearest", x.rTime]][
  , lapply(.SD, format, format = "%F %H:%M:%OS1 %Z")]
                  SampleTime                     rTime
1: 2018-06-01 00:51:40.0 UTC 2018-06-01 00:51:40.0 UTC
2: 2018-06-01 00:51:41.2 UTC 2018-06-01 00:51:41.0 UTC
3: 2018-06-01 00:51:41.4 UTC 2018-06-01 00:51:41.0 UTC
4: 2018-06-01 00:51:41.5 UTC 2018-06-01 00:51:41.0 UTC
5: 2018-06-01 00:51:41.9 UTC 2018-06-01 00:51:42.0 UTC
6: 2018-06-01 00:51:43.0 UTC 2018-06-01 00:51:43.0 UTC
7: 2018-06-01 00:51:46.0 UTC 2018-06-01 00:51:43.0 UTC
8: 2018-06-01 00:51:48.0 UTC 2018-06-01 00:51:43.0 UTC

基准

基准比较了三种不同的方法

  • OP 使用的 for 循环但修改为 return 索引向量
  • 使用 sapply()
  • 进行更简洁的重写
  • a 滚动连接到最近的

所有三个 return 索引向量。

基准数据包含 1000 个采样时间,这是一个相当小的测试用例。

library(data.table)
library(magrittr)
# create benchmark data
n <- 1000L
set.seed(1L)
SampleTime <- lubridate::as_datetime("2018-06-01") + cumsum(rnorm(n, 1)) %>% 
  sort()

rTime <- seq(lubridate::floor_date(min(SampleTime), "min"),
             lubridate::ceiling_date(max(SampleTime), "min"),
             by = "sec")

# perform benchmark
microbenchmark::microbenchmark(
  loop = {
    idx <- integer(length(SampleTime))
    for (i in 1:length(SampleTime)){
      idx[i] <- (which.min(abs(SampleTime[i] - rTime)))
    }
    idx
  },
  sapply = {
    sapply(
      seq_along(SampleTime), 
      function(i) which.min(abs(SampleTime[i] - rTime))
    )
  },
  roll_join = {
    sDT <- data.table(SampleTime)
    rDT <- data.table(rTime)
    rDT[sDT, on = .(rTime = SampleTime), roll = "nearest", which = TRUE]
  },
  times = 100L
)

滚动连接是最快的方法,快了 50 倍,即使对于这个相当小的基准案例也是如此:

Unit: milliseconds
      expr       min        lq      mean    median        uq        max neval cld
      loop 51.467338 53.365061 57.174145 54.722276 57.270950 214.442708   100   c
    sapply 49.833166 51.244187 53.600532 52.424695 55.126666  64.886196   100  b 
 roll_join  1.093099  1.355139  1.462512  1.408001  1.496544   5.411494   100 a