查找向量与另一个向量的元素最接近的日期的更快方法

时间:2018-06-26 09:42:04

标签: r date closest

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

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

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

此外,我想知道是否有人知道如何找到与SamplingTime的i元素最接近的两个数据点。我最初的方法是将posix格式转换为数字1,然后使用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 UTC

1 个答案:

答案 0 :(得分:1)

发布的问题实际上包含两个问题。第一个要求一种更快的方法来为rTime中给出的每个值找到SampleTime中最接近的值。

OP的for循环“打印” rTime中最接近的值的索引。 (好吧,实际上,OP的代码片段在没有print()语句或存储值的情况下不会返回什么。)

下面的代码使用{em>滚动连接到最近的来返回索引,可用于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循环,但已修改为返回索引向量
  • 使用sapply()进行更简洁的重写,并且
  • 滚动加入到最近的

这三个都返回索引向量。

基准数据包含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