R 通过两个变量滚动数据表中的联接，而不创建重复项

编辑日期：2019年9月30日：增加了示例，并修改了再现性代码

编辑2019年10月1日：更好的解释

我正在合并一个运输系统的两个不同的数据集。一个（df1）是列车在某个车站的时刻表，另一个（df2）是对经过这些车站的列车的观察

由于通常无法完成某些计划（列车中断、服务需要移除、施工现场等），观测数据集包含的条目比计划数据集少

我的目标是从乘客的角度衡量已实现计划的延误。这意味着：如果乘客知道列车应该在什么时候离开车站，他看到的延误对应于列车在准确的计划时间离开（延误=0），或下一班列车离开（延误=观察到的发车-计划发车）。
目标转化为以下任务： 通过以下方式合并两个数据集：
-停止\u id:因为我需要匹配每个站点的观测值，这显然是第一个匹配标准。
-时间戳：对于每个计划时间戳，我应该找到立即的连续的观察时间戳。
结果应显示所有可能的时间表（唯一，无重复）与最近的后续观察（唯一，无重复）相匹配。同样，我需要确保执行合并的方式，只有在计划之后或同时发生的观察与计划的适当时间戳相匹配。考虑到两个数据集之间的大小差异，我希望观察列中有大量NAs，因为时间表不能与观察配对

为简单起见，提供的示例仅包含我用于连接的两列：

车站id（车站id）和时间戳（应在车站观察列车的日期和时间）

我使用的方法是在R中使用带有Data.Table的滚动联接。这非常有效，除了这样一个事实，即每当我创建联接时，我都会得到一个数据集的副本，并且在合并集中不能有这些重复

我正在使用的代码：

#DECLARING FUNCTIONS (Two functions according to df1[df2] and df2[df1])

merge_schedule_obs <- function(df1, df2) {
  setDT(df1)
  setDT(df2)
  max_delay <- 3600 # 1-hour max delay for pairing schedule and occurrence
  setkey(df1, stop_id, departure)[, departScheduled:=departure]
  df3 <- df1[df2, roll = max_delay]
  return(df3)
}

merge_schedule_obs2 <- function(df1, df2) {
  setDT(df1)
  setDT(df2)
  max_delay <- 3600 # 1-hour max delay for pairing schedule and occurrence
  setkey(df1, stop_id, departure)[, departObserved:=departure]
  df3 <- df1[df2, roll = -max_delay]
  return(df3)
}

#声明函数（根据df1[df2]和df2[df1]的两个函数）
合并\u计划\u obs首先，您可以使用
unique
而不是
distinct
（后者可能来自
dplyr
；您不需要指定）
避免将数据表强制为数据帧

你很接近，
但是您需要切换联接中的表，
i、 类似于
df2[df1]
，
因此
df1
中的行用作搜索键，
然后可以使用
mult
删除重复项

以下是一种通过非等联接实现所需功能的方法：

setkey(df1, departure)
setkey(df2, departure)

df1[, max_departure := departure + as.difftime(1, units = "hours")
    ][, observed_departure := df2[df1,
                                  x.departure,
                                  on = .(stop_id, departure >= departure, departure <= max_departure),
                                  mult = "first"]
      ][, max_departure := NULL]

max\u dep
helper检查，
对于每一站和预定出发，
下一次航班是什么时候，
如果下一次出发时间在一小时内，则将
max_出发时间设置为“next-1秒”

另一种解决方案对此不起作用，因为，
只要观察到的起飞时间在预定起飞时间的一小时内，
这是一个有效的选择。
在我的例子中，这意味着10:31对10:30和10都有效。
请给我们举一些例子。谢谢您的评论。添加了示例。希望有帮助！好多了，谢谢你，@gonzo87请看一下答案，然后告诉我它是否适合你，@Gonz87:）Niiceee！！非常感谢，它工作得非常好！我还在做一些测试，但到目前为止，棒极了！好的，我运行了一些测试，在大数据集中，在观察到的_偏差中仍然有一些重复值，我真的无法计算出来。。。我不认为在我提供的小数据集中它是可复制的。。。如果有办法附上数据，我可以告诉你我的意思。。。不管怎样，谢谢你！！我找到了复制行为的原因。。。基本上，在这里添加一个“一小时窗口”：max_deposition:=deposition+as.difftime（1，units=“hours”）来匹配数据集会创建重复。我减少这个值越多，重复次数就越少，我的数据集看起来越稀疏（这是正确的、预期的行为）@Gonz87我不确定你看到的是否是
data.table
的结果。所使用的语法防止接受额外的行，因为通过引用添加到
df1
意味着传入向量（
x.department
此处）的元素数必须与行数相同。尝试从调用中删除
mult
，它会给您一个错误。@Gonz87我想这里可能有误解，您能检查我的编辑吗？
#MERGING DATASETS: (Both directions are covered, and the problem shows in both)

merged_df <- distinct(na.omit(merge_schedule_obs(df1,df2))) 

Out:

   stop_id           departure     departScheduled
1:   70005 2019-09-09 06:58:00 2019-09-09 06:58:00
2:   70005 2019-09-09 06:58:20 2019-09-09 06:58:00
3:   70007 2019-09-09 06:57:30 2019-09-09 06:55:10
4:   70009 2019-09-09 07:00:17 2019-09-09 06:57:00
5:   70013 2019-09-09 06:57:10 2019-09-09 06:54:00
6:   70015 2019-09-09 07:00:12 2019-09-09 06:57:00
7:   70019 2019-09-09 06:57:35 2019-09-09 06:55:30

merged_df2 <- distinct(na.omit(merge_schedule_obs2(df2,df1))) 

Out:
    stop_id           departure      departObserved
 1:   70005 2019-09-09 06:55:00 2019-09-09 06:58:00
 2:   70005 2019-09-09 06:58:00 2019-09-09 06:58:00
 3:   70007 2019-09-09 06:55:00 2019-09-09 06:57:30
 4:   70007 2019-09-09 06:55:10 2019-09-09 06:57:30
 5:   70009 2019-09-09 06:57:00 2019-09-09 07:00:17
 6:   70013 2019-09-09 06:54:00 2019-09-09 06:57:10
 7:   70015 2019-09-09 06:57:00 2019-09-09 07:00:12
 8:   70019 2019-09-09 06:54:30 2019-09-09 06:57:35
 9:   70019 2019-09-09 06:55:00 2019-09-09 06:57:35
10:   70019 2019-09-09 06:55:30 2019-09-09 06:57:35


setkey(df1, departure)
setkey(df2, departure)

df1[, max_departure := departure + as.difftime(1, units = "hours")
    ][, observed_departure := df2[df1,
                                  x.departure,
                                  on = .(stop_id, departure >= departure, departure <= max_departure),
                                  mult = "first"]
      ][, max_departure := NULL]

setkey(df1, departure)
setkey(df2, departure)

max_dep <- function(departure) {
  max_departure <- departure + as.difftime(1, units = "hours")

  next_departure <- shift(departure,
                          fill = max_departure[length(max_departure)] + as.difftime(1, units = "secs"),
                          type = "lead")

  invalid_max <- max_departure >= next_departure

  max_departure[invalid_max] <- next_departure[invalid_max] - as.difftime(1, units = "secs")
  max_departure
}

df1[, max_departure := max_dep(departure), by = "stop_id"
    ][, observed_departure := df2[df1,
                                  x.departure,
                                  on = .(stop_id, departure >= departure, departure <= max_departure),
                                  mult = "first"]
      ][, max_departure := NULL]