如果您的数据集太大而无法生成笛卡尔积,您也可以这样做:
df1 %>%
split(1:NROW(.)) %>%
map( ~merge(.x,
df2[ abs(difftime(df2$sent, .x$endtime, units='s')) < 20, ],
by=NULL) ) %>%
bind_rows()
编辑
TLDR
使用non-equi join from data.table,整体性能最好。
dt1 = as.data.table(df1)
dt2 = as.data.table(df2)
dt1[, `:=`(endtime_min = endtime - 20, endtime_max = endtime + 20) ]
dt1[dt2,
.(ID, ID1, endtime, sent),
on = .(endtime_min < sent, endtime_max > sent), nomatch = 0L, allow.cartesian=T]
加长版
我发布的答案在数据帧太大的情况下会更好,因为首先执行交叉连接会产生一个数据帧,其行数与两个数据帧的行数的乘积一样多。通过先过滤后加入,避免了不必要的内存分配。但是,对于df1 的每一行,它都有开销,检查df2 中是否有任何行匹配。
这个答案更好的另一个用例是当一个数据帧比另一个数据帧小得多时,即使它们没有那么大。我运行了一些基准来检查这一点。
但是,在遇到 this answer 并在 data.table 中为 OP 提出的问题制作解决方案版本之后,没有一个答案与此实现的性能相比。
我运行的测试使用了 OP 提供的数据集,为了模拟更大的数据集,我只是将这些数据集复制了一定次数。我做了 2 个测试:
- 复制两个数据集的次数相同
- 修复了
df1 的大小并复制了df2
对于每个测试,我测量了接受答案 (merge_filter)、我的原始答案 (filter_merge) 和 data.table 解决方案 (datatable) 的中位执行时间。
在运行测试之前,我准备好 df1 和 df2 以拥有正确的数据类型,并将列 ID 从 df1 重命名为 ID1。对于 data.table 解决方案,我将两个数据帧都转换为 data.tables 对应的 dt1 和 dt2。
对于每一种方法,我都要做一些改变,主要是使用merge(..., by=NULL)而不是crossing(...),因为最后一种方法不支持交叉连接重复行,从结果数据集中删除所有重复行。
这是我用来运行测试的代码:
library(tidyverse)
library(data.table)
run_test = function(n, n1=n, n2=n) {
df1 = bind_rows(rep(list(df1_op), n1))
df2 = bind_rows(rep(list(df1_op), n2))
dt1 = as.data.table(df1)
dt2 = as.data.table(df2)
microbenchmark::microbenchmark(
merge_filter = df1 %>%
merge(df2, by=NULL) %>%
filter(abs(difftime(sent, endtime, 'secs')) < 20),
filter_merge = df1 %>%
split(1:NROW(.)) %>%
map(~merge( .x,
df2[ abs(difftime(df2$sent, .x$endtime, units='s')) < 20, ],
by=NULL) ) %>%
bind_rows(),
datatable={
dt1[, `:=`(endtime_min = endtime - 20, endtime_max = endtime + 20) ]
dt1[dt2,
.(ID, ID1, endtime, sent),
on = .(endtime_min < sent, endtime_max > sent), nomatch = 0L, allow.cartesian=T]
}
)
}
test_1_list = list()
for( n in c(1, 2, 5, 10, 20, 50, 100, 200, 500) ) {
test_1_list[[ toString(n) ]] <- run_test(n)
}
test_2_list = list()
for( n in c(1, 2, 5, 10, 20, 50, 100, 200, 500,
1000, 2000, 5000, 10000, 20000, 50000) ) {
test_2_list[[ toString(n) ]] <- run_test(n, n1=1)
}
下面分别是测试 1 和 2 的结果:
编辑 2
您可以像这样进行非 equi 左连接:
filter_merge
df1 %>%
split(1:NROW(.)) %>%
map( ~merge(mutate(.x, k=1),
df2 %>%
filter( abs(difftime(df2$sent, .x$endtime, units='s')) < 20 ) %>%
mutate(k=1),
by="k",
all.x=T) %>%
select(-k) ) %>%
bind_rows() %>%
select(ID1, endtime, ID, sent)
# ID1 endtime ID sent
# 1 A 2020-01-07 01:35:08 E 2020-01-07 01:35:20
# 2 B 2020-01-07 01:39:00 <NA> <NA>
# 3 C 2020-01-10 01:45:00 <NA> <NA>
datatable
dt1[, `:=`(endtime_min = endtime - 20, endtime_max = endtime + 20) ]
dt2[dt1,
.(i.ID1, i.endtime, x.ID, x.sent),
on = .(sent > endtime_min, sent < endtime_max), allow.cartesian=T]
# i.ID1 i.endtime x.ID x.sent
# 1: A 2020-01-07 01:35:08 E 2020-01-07 01:35:20
# 2: B 2020-01-07 01:39:00 <NA> <NA>
# 3: C 2020-01-10 01:45:00 <NA> <NA>