将事件列表(瞬间)映射到 R 中的周期(间隔)列表(有或没有 lubridate)

Map a list of events (instants) to a list of periods (intervals) in R (with or without lubridate)

我有两个数据框。一个包含用 字符 唯一 ID 标记的时间段,另一个包含具有另一组与之关联的唯一 ID 的事件

期间 DF(代码):

periodID <- c("P_UID_00", "P_UID_01", "P_UDI_02", "P_UID_03")
periodStart <- as.POSIXct(c("2016/02/10 19:00", "2016/02/11 19:00", 
                            "2016/02/12 19:00", "2016/02/13 19:00"))
periodEnd <- as.POSIXct(c("2016/02/10 21:00", "2016/02/11 21:00", 
                          "2016/02/12 21:00", "2016/02/13 21:00"))
periodDF <- data.frame(periodID, periodStart, periodEnd)

期间 DF:

   periodID         periodStart           periodEnd
1 P_UID_00 2016-02-10 19:00:00 2016-02-10 21:00:00
2 P_UID_01 2016-02-11 19:00:00 2016-02-11 21:00:00
3 P_UDI_02 2016-02-12 19:00:00 2016-02-12 21:00:00
4 P_UID_03 2016-02-13 19:00:00 2016-02-13 21:00:00

事件 DF(代码):

eventID <- c("E_UID_00", "E_UID_01", "E_UDI_02", "E_UID_03")
eventTime <- as.POSIXct(c("2016/02/09 19:55:01", "2016/02/11 19:12:01", 
                         "2016/02/11 20:22:01", "2016/02/15 19:00:01"))
eventDF <- data.frame(eventID, eventTime)

事件方向:

   eventID           eventTime
1 E_UID_00 2016-02-09 19:55:01
2 E_UID_01 2016-02-11 19:12:01
3 E_UDI_02 2016-02-11 20:22:01
4 E_UID_03 2016-02-15 19:00:01

我想将第二个 DF 中的事件时间映射到第一个 DF 中的时间段,以便将事件 ID 与时间段 ID 匹配。基本上我想看到的结果 table 应该是这样的:

   eventID   periodID
1 E_UID_00   NA
2 NA         P_UID_00
3 E_UID_01   P_UID_01
4 E_UDI_02   P_UID_01
5 NA         P_UID_02
6 NA         P_UID_03
7 E_UID_03   NA

我想这可以通过使用 lubricate 将第一个 DF 中的开始和结束 cloumns 转换为间隔并使用某种形式的 applyinstant %within% interval 组合来实现,但我不是非常熟悉 lubridate,但未能生成有效代码

其他注意事项:
- 周期是完全任意的,可以持续几秒到几年
- 期间从不重叠,所以这不是问题
- 一个时间段可以关联多个事件
- DF 可以包含非关联table 事件和时间段
- 解决方案不得包含循环
- 不必用 lubridate 来解决,事实上,使用基础 R 的解决方案会更受欢迎。

我实际上设法想出了使用 lubridate 生成我想要的内容的代码。因此,如果有人知道如何在基础上执行此操作,或者比下面建议的方法更好的方法,我们将不胜感激!

首先,DF 期间的开始和结束时间应转换为 lubridate intervals:

intervalsP <- as.interval(periodStart, periodEnd)

第 2 步: 应创建一个函数来检查 瞬间 是否位于 间隔列表中。我创建一个单独函数的唯一原因是能够将它与 apply 一起使用:

PeriodAssign <- function(x, y){
    # x - instants
    # y - intervals
    variable1 <- mapply(`%within%`, x, y)
    if (length(y[variable1]) != 0) {
        as.character(y[variable1])
    } else {
        NA
    }
}

注意: 我必须使用 intervalcharacter 强制,因为否则间隔被 apply 函数强制到它们的长度(以秒为单位),因此对于匹配目的来说并不是真正有用的——即这个例子中的所有四个间隔都是相同的长度

步骤 3: 该函数可以用于事件 DF,然后可以合并两个 DF 以生成我正在寻找的 DF:
eventDF$intervals <- lapply(eventTime, PeriodAssign, intervalsP)

periodDF$intervals <- as.character(intervalsP)
mergedDF <- merge(periodDF, eventDF, by = "intervals")
presentableDF <- mergedDF[, c(2, 5)]

# adding in the unmatched Periods and Evenets
tDF1 <- data.frame(periodDF[!(periodDF$periodID %in% presentableDF$periodID), 1], NA)
colnames(tDF1) <- c("periodID", "eventID")
presentableDF <- rbind(presentableDF, tDF1)

tDF2 <- data.frame(NA, eventDF[!(eventDF$eventID %in% presentableDF$eventID), 1])
colnames(tDF2) <- c("periodID", "eventID")
presentableDF <- rbind(presentableDF, tDF2)
presentableDF <- presentableDF[order(presentableDF[,1]),]

最终的 DF 看起来像:

> presentableDF
  periodID  eventID
3 P_UID_00     <NA>
1 P_UID_01 E_UID_01
2 P_UID_01 E_UDI_02
4 P_UID_02     <NA>
5 P_UID_03     <NA>
6     <NA> E_UID_00
7     <NA> E_UID_03