通过两个变量滚动加入 Data.Table 而不创建重复项

Question

编辑 2019 年 9 月 30 日:添加示例和修改代码以实现可重现性。

编辑 01.10.2019:更好的解释。

我正在合并交通系统的两个不同数据集。一个 (df1) 是火车应该在某个车站的时刻表，另一个 (df2) 是对经过这些车站的火车的观察。

由于无法完成某些时间表(火车坏了、需要取消服务、建筑工地等)是很常见的，因此观察数据集包含的条目少于时间表。

我的目标是从乘客的角度衡量已实现时刻表的延误情况。这意味着:如果乘客知道火车应该在什么时间离开车站，他看到的延迟对应于火车在确切的预定时间离开 (delay = 0) 或紧接的下一类火车 < strong>(延迟 = depart_observed - depart_scheduled)。
目标转化为以下任务:通过以下方式合并两个数据集:
-stop_id: 因为我需要匹配每个站点的观测值，所以这显然是第一个匹配条件。
-时间戳:对于每个计划时间戳，我应该找到即时的连续观察时间戳。
结果应显示所有可能的时间表(唯一，无重复)与最接近的后续观察(也唯一，无重复)相匹配。同样，我需要确保执行合并的方式，只有在时间表之后或同时发生的观察才与时间表的正确时间戳相匹配。考虑到两个数据集之间的大小差异，我期望观察列中有大量 NA，因为时间表无法与观察配对。

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

stop_id(车站的 id)和 timestamp(列车应该或在车站观察的日期和时间)。

我使用的方法是在 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)
}

#CREATING SOME SAMPLE DATA (The real dataset is significantly larger. But this example should cover the problem)


#Sample Schedule Data:

df1 <- distinct(data.table(stop_id = as.factor(c("70015","70009", "70003", "70019","70013", "70007", "70019", "70005", "70007", "70019", "70005")),
                           departure = as.POSIXct(c("2019-09-09 06:57:00","2019-09-09 06:57:00", "2019-09-09 06:57:00",
                                                    "2019-09-09 06:54:30","2019-09-09 06:54:00", "2019-09-09 06:55:00",
                                                    "2019-09-09 06:55:30","2019-09-09 06:55:00", "2019-09-09 06:55:10",
                                                    "2019-09-09  06:55:00", "2019-09-09  06:58:00"))))



Out:

    stop_id           departure
 1:   70015 2019-09-09 06:57:00
 2:   70009 2019-09-09 06:57:00
 3:   70003 2019-09-09 06:57:00
 4:   70019 2019-09-09 06:54:30
 5:   70013 2019-09-09 06:54:00
 6:   70007 2019-09-09 06:55:00
 7:   70019 2019-09-09 06:55:30
 8:   70005 2019-09-09 06:55:00
 9:   70007 2019-09-09 06:55:10
10:   70019 2019-09-09 06:55:00
11:   70005 2019-09-09 06:58:00

#Sample Observations Data:

df2 <- distinct(data.table(stop_id = as.factor(c("70013","70009", "70015", "70005", "70005", "70007", "70019")),
                           departure = as.POSIXct(c("2019-09-09 06:57:10","2019-09-09 07:00:17", "2019-09-09 07:00:12",  "2019-09-09  06:58:20", "2019-09-09  06:58:00",
                                                    "2019-09-09 06:57:30", "2019-09-09 06:57:35")))
)

Out:

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

#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

运行与数据集 df1 和 df2 的滚动连接的结果在站 70005 中创建了一个重复的时间表条目(如果我以相反的方式运行连接 df1[df2, roll = max_delay, ...] 重复项相反，发生在观测站 70005 和 70019)。基本上，我无法摆脱它们。我尝试了 mult 的选项(第一个，最后一个)并尝试使用 rollends ......仍然总是不需要重复......

如何合并这些数据集而不产生任何重复？

谢谢!

Answer 1

首先，您可以使用 unique 而不是 distinct(后者可能来自 dplyr；您未指定)以避免将数据表强制转换为数据框。

你很接近，但是你需要在连接中切换表，即类似 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]

我们按departure(通过setkey)排序，以便mult = "first" 返回 future 允许范围内最接近的匹配项。必须分配中间列 max_departure 并随后将其删除，因为非等连接只能使用现有列。另请注意，使用的语法来自 this answer(使用 .SD 而不是 df1 的版本在这种情况下不起作用，我不知道为什么)。

---

编辑:根据评论，我突然想到，当你说“重复”时，你可能指的是不同的东西。假设您计划在 10 点和 10:30 出发，但是 10 点的那个永远不会发生，观察到的出发时间是 10:31。也许您的意思是 10:31 是观察到的预定于 10:30 出发的航类，并且不能用于 10 点的那个？如果是这样的话，也许这会起作用:

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]

max_dep 助手检查，对于每一站和预定的出发时间，下一次预定起飞时间是什么时候，如果下一次出发时间在一小时内，则将 max_departure 设置为“next -1 second”。

其他解决方案对此不起作用，因为，只要观察到的出发时间在预定出发时间的一小时内，这是一个有效的选择。在我的示例中，这意味着 10:31 对 10:30 和 10 都有效。