将特定时间间隔内来自 2 个不同数据集的值合并到单个数据集 (R)

Question

我有两个独立的数据集：df1 和 df2。我想创建一个新的数据集 df3，如果日期时间彼此相差 20 秒以内，它将 df1 的结束时间列与 df2 的发送列相匹配。

 df1

 endtime                     ID

 1/7/2020  1:35:08 AM         A
 1/7/2020  1:39:00 AM         B
 1/20/2020 1:45:00 AM         C



 df2

sent                         ID

1/7/2020  1:35:20 AM          E
1/7/2020  1:42:00 AM          F
1/20/2020 1:55:00 AM          G
1/20/2020 2:00:00 AM          E

这是我想要的 df3 输出。只有一行，因为只有两个值符合结束时间和已发送列的 20 秒内条件。

endtime                  sent 

1/7/2020 1:35:08 AM      1/7/2020  1:35:20 AM

这是输出：

df1

structure(list(endtime = structure(c(2L, 3L, 1L), .Label = c("1/10/2020 1:45:00 AM", 
"1/7/2020 1:35:08 AM", "1/7/2020 1:39:00 AM"), class = "factor"), 
ID = structure(1:3, .Label = c("A", "B", "C"), class = "factor")), class = "data.frame", row.names =   c(NA, 
 -3L))





 df2

 structure(list(sent = structure(c(3L, 4L, 1L, 2L), .Label = c("1/20/2020 1:55:00 AM", 
 "1/20/2020 2:00:00 AM", "1/7/2020 1:35:20 AM", "1/7/2020 1:42:00 AM"
 ), class = "factor"), ID = structure(c(1L, 2L, 3L, 1L), .Label = c("E", 
"F", "G"), class = "factor")), class = "data.frame", row.names = c(NA, 
-4L))

这是我试过的：

我正在考虑执行左连接并匹配值，或者我可以使用 merge()，但棘手的部分是将值与条件语句匹配。任何建议表示赞赏。

library(dplyr)
left_join(df1, df2)

Answer 1

由于没有要连接的公共列，我们可以使用 crossing 创建所有行的组合，然后 filter 符合条件的行。

library(dplyr)

df1 %>%
  rename(ID1 = 'ID') %>%
  tidyr::crossing(df2) %>%
  mutate_at(vars(endtime, sent), lubridate::mdy_hms) %>%
  filter(abs(difftime(sent, endtime, 'secs')) < 20)

#  endtime             ID1   sent                ID   
#  <dttm>              <fct> <dttm>              <fct>
#1 2020-01-07 01:35:08 A     2020-01-07 01:35:20 E

Answer 2

如果您的数据集太大而无法制作笛卡尔积，您也可以这样做：

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.

中是否有匹配的行

这个答案会更好的另一个用例是当一个数据框比另一个小得多时，即使它们不是那么大。我运行一些基准来检查这个。

然而，在遇到并在 data.table 中针对 OP 提出的问题制作解决方案版本后，none 的答案与性能相比这个实现。

我运行的测试使用了 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

您可以像这样进行非等值左连接：

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>

将特定时间间隔内来自 2 个不同数据集的值合并到单个数据集 (R)

Merging values from 2 different datasets within a certain time interval into a single dataset (R)

merge

r

lubridate

stringr

dplyr

编辑

编辑 2