OP 提出了两个问题:
- 使用
lubridate 中的%within% 运算符是最佳方法吗?
- 是否可以将其自动化,以便 OP 不必手写所有 60 个间隔?
先回答第二个问题:是的,有可能:
%within%、lapply() 和 interval()
OP 快到了。根据a %within% b的documentation,
如果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 个音程的工作量。
现在,这个问题已经解决了,让我们比较一下迄今为止发布的三种不同方法的执行速度:
-
%within% 和 interval() 来自 lubridate
-
expand.grid() 建议 marcguery
-
%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)。