我有一个时间相关事件的数据框.
这是一个例子:
Name Event Order Sequence start_event end_event duration Group
JOHN 1 A 0 19 19 ID1
JOHN 2 A 60 112 52 ID1
JOHN 3 A 392 429 37 ID1
JOHN 4 B 282 329 47 ID1
JOHN 5 C 147 226 79 ID1
JOHN 6 C 566 611 45 ID1
ADAM 1 A 19 75 56 ID2
ADAM 2 A 384 407 23 ID2
ADAM 3 B 0 79 79 ID2
ADAM 4 B 505 586 81 ID2
ADAM 5 C 140 205 65 ID2
ADAM 6 C 522 599 77 ID2
基本上有两个不同的组,ID 1和2.对于每个组,有18个不同的名称.每个人都出现在3个不同的序列中,AC.然后,他们在这些序列中有活跃的时间段,我标记开始/结束事件并计算持续时间.
我想隔离每个人,并找出他们在相反和相同的组ID中与人匹配的时间间隔.
使用上面的示例数据,我想找到John和Adam在同一序列中同时出现的时间.然后我想将John与ID1/ID2中17个名字的其余部分进行比较.
我并不需要匹配的共享"活动"时间的确切数额,我很希望能是常见的行隔离.
我的舒适在于使用dplyr,但我还是无法解决这个问题.我环顾四周,看到了一些与邻接矩阵相似的例子,但这些例子都是精确而准确的数据点.我无法用范围/间隔找出策略.
谢谢!
更新:这是所需结果的示例
Name Event Order Sequence start_event end_event duration Group
JOHN 3 A 392 429 37 ID1
JOHN 5 C 147 226 79 ID1
JOHN 6 C 566 611 45 ID1
ADAM 2 A 384 407 23 ID2
ADAM 5 C 140 205 65 ID2
ADAM 6 C 522 599 77 ID2
我想你要为John隔离每个事件行,标记开始/结束时间帧,然后遍历每个名称和事件以查找数据帧的其余部分,以找到首先适合同一序列的时间点,然后其次是针对约翰的替补标记的开始/结束时间框架.
据我了解，您想返回任何行，其中具有特定序列号的John事件与具有相同序列值的其他任何人的事件重叠。为此，您可以使用split-apply-combine按顺序拆分，识别重叠的行，然后重新组合：
overlap <- function(start1, end1, start2, end2) pmin(end1, end2) > pmax(start2, start1)
do.call(rbind, lapply(split(dat, dat$Sequence), function(x) {
jpos <- which(x$Name == "JOHN")
njpos <- which(x$Name != "JOHN")
over <- outer(jpos, njpos, function(a, b) {
overlap(x$start_event[a], x$end_event[a], x$start_event[b], x$end_event[b])
})
x[c(jpos[rowSums(over) > 0], njpos[colSums(over) > 0]),]
}))
# Name EventOrder Sequence start_event end_event duration Group
# A.2 JOHN 2 A 60 112 52 ID1
# A.3 JOHN 3 A 392 429 37 ID1
# A.7 ADAM 1 A 19 75 56 ID2
# A.8 ADAM 2 A 384 407 23 ID2
# C.5 JOHN 5 C 147 226 79 ID1
# C.6 JOHN 6 C 566 611 45 ID1
# C.11 ADAM 5 C 140 205 65 ID2
# C.12 ADAM 6 C 522 599 77 ID2
请注意，我的输出包括问题中未显示的另外两个行-时间范围[60，112]中的John的序列A，与时间范围[19，75]中的Adam的序列A重叠。
这可以很容易地映射到dplyr语言中：
library(dplyr)
overlap <- function(start1, end1, start2, end2) pmin(end1, end2) > pmax(start2, start1)
sliceRows <- function(name, start, end) {
jpos <- which(name == "JOHN")
njpos <- which(name != "JOHN")
over <- outer(jpos, njpos, function(a, b) overlap(start[a], end[a], start[b], end[b]))
c(jpos[rowSums(over) > 0], njpos[colSums(over) > 0])
}
dat %>%
group_by(Sequence) %>%
slice(sliceRows(Name, start_event, end_event))
# Source: local data frame [8 x 7]
# Groups: Sequence [3]
#
# Name EventOrder Sequence start_event end_event duration Group
# (fctr) (int) (fctr) (int) (int) (int) (fctr)
# 1 JOHN 2 A 60 112 52 ID1
# 2 JOHN 3 A 392 429 37 ID1
# 3 ADAM 1 A 19 75 56 ID2
# 4 ADAM 2 A 384 407 23 ID2
# 5 JOHN 5 C 147 226 79 ID1
# 6 JOHN 6 C 566 611 45 ID1
# 7 ADAM 5 C 140 205 65 ID2
# 8 ADAM 6 C 522 599 77 ID2
如果您希望能够为指定的一对用户计算重叠，可以通过将该操作包装到一个指定要处理的用户对的函数中来完成：
overlap <- function(start1, end1, start2, end2) pmin(end1, end2) > pmax(start2, start1)
pair.overlap <- function(dat, user1, user2) {
dat <- dat[dat$Name %in% c(user1, user2),]
do.call(rbind, lapply(split(dat, dat$Sequence), function(x) {
jpos <- which(x$Name == user1)
njpos <- which(x$Name == user2)
over <- outer(jpos, njpos, function(a, b) {
overlap(x$start_event[a], x$end_event[a], x$start_event[b], x$end_event[b])
})
x[c(jpos[rowSums(over) > 0], njpos[colSums(over) > 0]),]
}))
}
您可以pair.overlap(dat, "JOHN", "ADAM")用来获取先前的输出。现在可以使用combn和生成每对用户的重叠apply：
apply(combn(unique(as.character(dat$Name)), 2), 2, function(x) pair.overlap(dat, x[1], x[2]))