R中一个事件与另一个事件的匹配时间间隔

Question

我是在尝试做不可能的事情吗？如果事件 2 或事件 2 之前的 10 天与事件 1 中的日期相交，我想将 df1 中的事件与 df2 中的事件进行匹配。我粘贴了两个数据集中的样本。我在这个论坛上看过但找不到与此问题类似的任何内容，所以这可能是不可能的。提前致谢！

head(df1)
    # A tibble: 6 x 1
    # Groups:   event1 [6]
      event1
       <date>     
    1 1980-01-10 
    2 1980-01-13 
    3 1980-01-14 
    4 1980-02-18 
    5 1980-02-27 
    6 1980-03-02 

head(df2)

      event2
    1  1980-01-16
    2  1980-01-18
    3  1980-01-19
    4  1980-02-12
    5  1980-09-26
    6  1980-10-23

我想我想要的是这样的（使用前三个event2s）：

ev_1 <- interval(ymd('1980-01-06'), ymd('1980-01-16'))
ev_2 <- interval(ymd('1980-01-08'), ymd('1980-01-18')) 
ev_3 <- interval(ymd('1980-01-09'), ymd('1980-01-19'))

然后，我想看看是否有任何 event1 日期发生在间隔期间。在 40 年的时间里，我总共有大约 60 个 event2 日期和数百个 event1 日期。

我能够使用说明 here 想出这个方法，但这是最好的方法吗？如果是这样，是否可以将其自动化，这样我就不必手写所有 60 个间隔？

> dates_test <- ymd(c("1980-01-10", "1980-01-13", "1980-01-14", "1980-02-18"))
> interval_test<- list(interval(ymd('1980-01-06'), ymd('1980-01-16')),
                       interval(ymd('1980-01-09'), ymd('1980-01-19')))
> dates_test %within% interval_test
[1]  TRUE  TRUE  TRUE FALSE

Answer 1

您可以创建事件 1 和事件 2 的所有可能组合，然后在事件 2 比事件 1 晚 10 天或更短时保留行。

combinations <- expand.grid(df1$event1, df2$event2)
matches <- combinations[combinations[,2] >= combinations[,1] & combinations[,2] - combinations[,1] <= 10,]
matches

         Var1       Var2
1  1980-01-10 1980-01-16
2  1980-01-13 1980-01-16
3  1980-01-14 1980-01-16
7  1980-01-10 1980-01-18
8  1980-01-13 1980-01-18
9  1980-01-14 1980-01-18
13 1980-01-10 1980-01-19
14 1980-01-13 1980-01-19
15 1980-01-14 1980-01-19

Answer 2

OP 问了两个问题：

使用 lubridate 中的 %within% 运算符是最好的方法吗？
是否可以将其自动化，以便 OP 不必手写所有 60 个间隔？

先回答第二个问题：是的，有可能：

`%within%`、`lapply()` 和 `interval()`

OP 快到了。根据a %within% b的documentation，

If b is a list of intervals, a is checked if it falls within any of the intervals

我们可以通过

从给定的日期向量 df2$event2 创建间隔列表

lapply(df2$event2, function(x) interval(x - 10, x))

[[1]]
[1] 1980-01-06 UTC--1980-01-16 UTC

[[2]]
[1] 1980-01-08 UTC--1980-01-18 UTC

[[3]]
[1] 1980-01-09 UTC--1980-01-19 UTC

[[4]]
[1] 1980-02-02 UTC--1980-02-12 UTC

[[5]]
[1] 1980-09-16 UTC--1980-09-26 UTC

[[6]]
[1] 1980-10-13 UTC--1980-10-23 UTC

每个间隔的 start 日期是从 end 日期减去 10 天计算得出的。所以，

library(lubridate)
df1$event1 %within% lapply(df2$event2, function(x) interval(x - 10, x))

returns 一个逻辑向量（符合OP的预期结果）

[1]  TRUE  TRUE  TRUE FALSE FALSE FALSE

可用于子集 df1 以从 df1 中选择匹配事件作为日期向量

df1[df1$event1 %within% lapply(df2$event2, function(x) interval(x - 10, x)), ]

[1] "1980-01-10" "1980-01-13" "1980-01-14"

或

df1[df1$event1 %within% lapply(df2$event2, function(x) interval(x - 10, x)), , drop = FALSE]

其中 return 是子集 data.frame。

      event1
1 1980-01-10
2 1980-01-13
3 1980-01-14

`%inrange%` 来自 `data.table`

为了完整起见，data.table包提供了类似的运算符%inrange:

library(data.table)
setDT(df1)
setDT(df2)
df1[event1 %inrange% df2[, .(event2 - 10L, event2)]]

       event1
1: 1980-01-10
2: 1980-01-13
3: 1980-01-14

setDT(df1) 和 setDT(df2) 强制 data.frame 到 data.table 对象。

基准测试

现在，我们可以尝试回答 OP 关于“最佳方法”的第一个问题。

OP 没有指定判断方法为“最佳”的标准。 OP 可能主要关心的是手工编写 60 个间隔的工作量。

现在，这个问题已经解决了，所以让我们比较一下目前发布的三种不同方法 执行速度:

%within% 和 interval() 来自 lubridate
expand.grid() 由
%inrange% 来自 data.table

为了进行基准测试，使用了 bench 包，因为它测量执行时间以及不同问题大小的内存分配。它还检查结果是否相同。因此，这三种方法被修改为return一个日期向量。

library(bench)
library(ggplot2)
bm <- press(
  n1 = c(100L, 1E3L, 1E4L),
  n2 = c(10L, 100L, 1000L),
  {
    beg <- as.Date("1980-01-01")
    end <- as.Date("2020-12-31")
    df1 <- data.frame(event1 = seq(beg, end, length.out = n1))
    df2 <- data.frame(event2 = seq(beg, end, length.out = n2))
    dt1 <- as.data.table(df1)
    dt2 <- as.data.table(df2)
    mark(
      within = {
        df1[df1$event1 %within% lapply(df2$event2, function(x) interval(x - 10, x)), ]
      },
      inrange = {
        dt1[event1 %inrange% dt2[, .(event2 - 10L, event2)], event1]
      },
      exp.grid = {
        combinations <- expand.grid(df1$event1, df2$event2)
        matches <- combinations[combinations[,2] >= combinations[,1] & 
                       combinations[,2] - combinations[,1] <= 10,]
        unique(matches[[1L]])
      },
      check = TRUE
    )
  }
)
autoplot(bm)

请注意对数时间尺度。

仅对于最小的问题规模，expand.grid() 方法是最快的。对于所有其他问题大小（包括接近 OP 问题大小的 1000 event1 和 100 event2 的情况），data.table 的 %inrange% 是最快的。对于 10000 event1 和 1000 event2 的最大情况，data.table 比其他方法快超过 2 个幅度。

library(dplyr)
bm %>% 
  select(1:11) %>% 
  filter(n1 == max(n1), n2 == max(n2)) %>% 
  mutate(expression = names(expression) %>% unique())

# A tibble: 3 x 11
  expression    n1    n2      min   median `itr/sec` mem_alloc `gc/sec` n_itr  n_gc total_time
  <chr>      <int> <int> <bch:tm> <bch:tm>     <dbl> <bch:byt>    <dbl> <int> <dbl>   <bch:tm>
1 within     10000  1000 780.16ms  780.2ms      1.28     307MB     2.56     1     2      780ms
2 inrange    10000  1000   2.68ms    3.3ms    293.       491KB     0      147     0      502ms
3 exp.grid   10000  1000 834.35ms  834.3ms      1.20     882MB     3.60     1     3      834ms

此外，data.table 分配了 3 个数量级 更少的内存（分别为 0.5MB 与 307MB 或 882MB）。

R中一个事件与另一个事件的匹配时间间隔

Matching time interval of one event with another event in R

r

intervals

lubridate

timespan

`%within%`、`lapply()` 和 `interval()`

`%inrange%` 来自 `data.table`

基准测试

R中一个事件与另一个事件的匹配时间间隔

Matching time interval of one event with another event in R

r

intervals

lubridate

timespan

%within%、lapply() 和 interval()

%inrange% 来自 data.table

基准测试

`%within%`、`lapply()` 和 `interval()`

`%inrange%` 来自 `data.table`