【问题标题】:Matching time interval of one event with another event in RR中一个事件与另一个事件的匹配时间间隔
【发布时间】:2020-08-04 21:39:41
【问题描述】:

我是在尝试做不可能的事吗?如果 event2 或 event2 之前的 10 天期间与 event1 中的日期相交,我想将 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

【问题讨论】:

  • 您所描述的时间间隔是从 event2 前 10 天开始到 event2 结束吗?
  • 是的。 event1 的日期是离散的日期。对于 event2,我想要前 10 天的间隔。
  • 感谢您提及“间隔”。使用该词作为搜索词导致我:stackoverflow.com/questions/41497351/…。我认为那里有一个适合我的答案。似乎有很多选择!

标签: r intervals lubridate timespan


【解决方案1】:

您可以创建 event1 和 event2 的所有可能组合,然后在 event2 在 event1 之后 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

【讨论】:

  • 哇,效果很好!非常感谢!!!谢谢漂亮!
【解决方案2】:

OP 提出了两个问题:

  1. 使用lubridate 中的%within% 运算符是最佳方法吗?
  2. 是否可以将其自动化,以便 OP 不必手写所有 60 个间隔?

先回答第二个问题:是的,有可能:

%within%lapply()interval()

OP 快到了。根据a %within% bdocumentation

如果b 是一个区间列表,则检查a 是否属于任意 间隔

我们可以从给定的日期向量 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))

返回一个逻辑向量(符合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]

返回子集的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.frames 强制转换为 data.table 对象。

基准测试

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

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

现在,这个问题已经解决了,让我们比较一下迄今为止发布的三种不同方法的执行速度

  1. %within%interval() 来自 lubridate
  2. expand.grid() 建议 marcguery
  3. %inrange% 来自data.table

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

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)。

【讨论】:

    猜你喜欢
    • 1970-01-01
    • 1970-01-01
    • 2015-02-24
    • 2023-03-26
    • 1970-01-01
    • 1970-01-01
    • 2011-09-11
    • 1970-01-01
    • 1970-01-01
    相关资源
    最近更新 更多