r - 将不规则的日期时间(缺少日期时间)与常规的日期时间安排相匹配

Question

假设 datetimes1 是不规则时间间隔的日期时间，datetimes2 是规则时间间隔的日期时间。 datetimes1 缺少一些日期时间，例如 5:10，如第一个表中所示。

我想要的是尝试将 datetimes1 与 datetimes2 匹配，以便每个 datetimes1 都接近于 datetimes2 并且所有 datetimes1 都在看似正确的行中。

起初，我尝试将 datetimes1 四舍五入到最接近的 5 分钟，并尝试将它们与 datetimes2 相匹配，但有些日期时间偏离了 3 分钟，因此四舍五入不正确值(value)观。

接下来我尝试的是找出哪些 datetimes1 与 datetimes2 完全相等，并将那些 datetimes1 与 datetimes2 匹配> 首先，通过将 tolerance 设置为 0，然后开始在每个循环中将 tolerance 增加 1，并匹配尚未匹配的 datetimes1到 datetimes2，它由指定的 tolerance 关闭。

此方法的问题是 5:33 和 5:37 都从 5:35 开始相差 2 分钟，因此 5:33 首先匹配到 5:35，然后 5:37 不包含在 table 。有关我使用给定代码获得的结果，请参见第二张表。

你知道我该如何解决这个问题吗？

我想看到的:

           datetimes1          datetimes2
1 2014-07-24 05:05:00 2014-07-24 05:05:00
2                <NA> 2014-07-24 05:10:00
3 2014-07-24 05:15:00 2014-07-24 05:15:00
4 2014-07-24 05:23:00 2014-07-24 05:20:00
5 2014-07-24 05:27:00 2014-07-24 05:25:00
6 2014-07-24 05:33:00 2014-07-24 05:30:00
7 2014-07-24 05:37:00 2014-07-24 05:35:00
8 2014-07-24 05:41:00 2014-07-24 05:40:00
9 2014-07-24 05:45:00 2014-07-24 05:45:00

但我得到的是这个:

           datetimes1          datetimes2
1 2014-07-24 05:05:00 2014-07-24 05:05:00
2                <NA> 2014-07-24 05:10:00
3 2014-07-24 05:15:00 2014-07-24 05:15:00
4                <NA> 2014-07-24 05:20:00
5 2014-07-24 05:23:00 2014-07-24 05:25:00
6 2014-07-24 05:27:00 2014-07-24 05:30:00
7 2014-07-24 05:33:00 2014-07-24 05:35:00
8 2014-07-24 05:41:00 2014-07-24 05:40:00
9 2014-07-24 05:45:00 2014-07-24 05:45:00

这是我的代码:

irregulars <- c("2014-07-24 05:05",
                "2014-07-24 05:15",
                "2014-07-24 05:23",
                "2014-07-24 05:27",
                "2014-07-24 05:33",
                "2014-07-24 05:37",
                "2014-07-24 05:41",
                "2014-07-24 05:45")

df1 <- data.frame(datetimes <- as.POSIXct(irregulars, "GMT"))

regulars <- c("2014-07-24 05:05",
              "2014-07-24 05:10",
              "2014-07-24 05:15", 
              "2014-07-24 05:20",
              "2014-07-24 05:25",
              "2014-07-24 05:30",
              "2014-07-24 05:35",
              "2014-07-24 05:40",
              "2014-07-24 05:45")

df2 <- setNames(data.frame(matrix(NA,length(regulars),2)),c("datetimes1","datetimes2"))
df2$datetimes2 <- as.POSIXct(regulars, "GMT")

# Match irregulars to regulars
for(tolerance in c(0:3)) {
  for(idx in which(!df1$datetimes %in% df2$datetimes1)) {
    dt <- abs(difftime(df2$datetimes2, df1$datetimes[idx], "GMT", "mins"))
    dt.min <- min(dt[is.na(df2$datetimes1)])
    if (dt.min > tolerance) next
    idx2 <- which(dt == dt.min)
    df2$datetimes1[idx2] <- df1$datetimes[idx]
  }
}

df2$datetimes1 <- as.POSIXct(df2$datetimes1, "GMT", origin = "1970-01-01 00:00:00")

Answer 1

这是一种方法。假设我们的匹配算法是从一组候选者中找到与目标 x 具有最小绝对差异的时间，条件是差异必须低于容差水平(比如 5 分钟，或 300 秒):

closest <- function(x, candidates, tol = 300) {
  timediff <- abs(difftime(x, candidates, units = "secs"))
  if (all(timediff >= tol)) return(NA)
  candidates[which.min(timediff)]
}

在我们的案例中，候选者是一组“非正规者”，我们的目标是“正规者”。这里的主要思想是遍历“常规”，每当我们从候选集中找到匹配项时，我们就将其从候选集中删除:

candidates <- irregulars
out <- sapply(regulars, function(x) {
    matched <- closest(x, candidates, tol = 300)
    candidates <<- setdiff(candidates, matched)
    matched
})

这是完整的 MWE。首先设置时间向量:

irregulars <- c("2014-07-24 05:05",
                "2014-07-24 05:15",
                "2014-07-24 05:23",
                "2014-07-24 05:27",
                "2014-07-24 05:33",
                "2014-07-24 05:37",
                "2014-07-24 05:41",
                "2014-07-24 05:45")

regulars <- c("2014-07-24 05:05",
              "2014-07-24 05:10",
              "2014-07-24 05:15", 
              "2014-07-24 05:20",
              "2014-07-24 05:25",
              "2014-07-24 05:30",
              "2014-07-24 05:35",
              "2014-07-24 05:40",
              "2014-07-24 05:45")

定义最近的函数并迭代:

closest <- function(x, candidates, tol = 600) {
  timediff <- abs(difftime(x, candidates, units = "secs"))
  if (all(timediff >= tol)) return(NA)
  candidates[which.min(timediff)]
}

candidates <- irregulars
out <- sapply(regulars, function(x) {
    matched <- closest(x, candidates, tol = 300)
    candidates <<- setdiff(candidates, matched)
    matched
})

显示输出:

data.frame(datetimes1 = out,
           datetimes2 = names(out),
           row.names = NULL)
#        datetimes1       datetimes2
# 1 2014-07-24 05:05 2014-07-24 05:05
# 2             <NA> 2014-07-24 05:10
# 3 2014-07-24 05:15 2014-07-24 05:15
# 4 2014-07-24 05:23 2014-07-24 05:20
# 5 2014-07-24 05:27 2014-07-24 05:25
# 6 2014-07-24 05:33 2014-07-24 05:30
# 7 2014-07-24 05:37 2014-07-24 05:35
# 8 2014-07-24 05:41 2014-07-24 05:40
# 9 2014-07-24 05:45 2014-07-24 05:45