匹配时间范围前后的记录
Match records immediately before and after time range
我的objective是将两个数据table根据时间和dplyr或data.table进行join，具体是获取事件前后的记录.
在示例数据中，本例中的事件是踏板车旅行。以下是四次旅行 - 两次由滑板车 1 进行，两次由滑板车 2 进行。
> testScooter
start end id
1: 2018-01-18 22:19:13 2018-01-18 22:26:31 1
2: 2018-01-18 23:29:22 2018-01-18 23:37:53 1
3: 2018-01-18 00:22:02 2018-01-18 00:29:21 2
4: 2018-01-18 00:37:52 2018-01-18 01:06:53 2
在单独的 table 中，记录的间隔几乎相等。 ids 匹配并且踏板车在旅行中被标记为 no。
> intervals
id time available charge
1 1 2018-01-18 21:31:07 yes 83
2 1 2018-01-18 21:41:07 yes 83
3 1 2018-01-18 21:51:07 yes 83
4 1 2018-01-18 22:01:07 yes 83
5 1 2018-01-18 22:11:07 yes 83
6 1 2018-01-18 22:21:07 no 83
7 1 2018-01-18 22:31:07 yes 81
8 1 2018-01-18 22:41:08 yes 81
9 1 2018-01-18 22:51:08 yes 81
10 1 2018-01-18 23:01:08 yes 81
11 1 2018-01-18 23:11:08 yes 81
12 1 2018-01-18 23:21:11 yes 81
13 1 2018-01-18 23:31:07 no 81
14 1 2018-01-18 23:41:09 yes 79
15 1 2018-01-18 23:51:07 yes 79
16 2 2018-01-18 00:01:06 yes 84
17 2 2018-01-18 00:11:06 yes 84
18 2 2018-01-18 00:21:06 yes 84
19 2 2018-01-18 00:31:05 yes 80
20 2 2018-01-18 00:41:06 no 80
21 2 2018-01-18 00:51:06 no 80
22 2 2018-01-18 01:01:06 no 80
23 2 2018-01-18 01:11:05 yes 80
24 2 2018-01-18 01:21:05 yes 80
25 2 2018-01-18 01:31:05 yes 80
我尝试生成的输出如下。
> output
start end id startCharge endCharge
1: 2018-01-18 22:19:13 2018-01-18 22:26:31 1 83 81
2: 2018-01-18 23:29:22 2018-01-18 23:37:53 1 81 79
3: 2018-01-18 00:22:02 2018-01-18 00:29:21 2 84 80
4: 2018-01-18 00:37:52 2018-01-18 01:06:53 2 80 80
关于如何在时间范围之前和之后的最近时间进行匹配的任何建议都会有所帮助，也许可以使用 data.table 包中的 lubridate::new_interval() 或 roll='nearest' 但我不是确定从哪里开始。
# Here is the sample data
library(data.table)
testScooter <- setDT(
structure(list(start = structure(c(1516313953, 1516318162, 1516234922,
1516235872), tzone = "", class = c("POSIXct", "POSIXt")), end = structure(c(1516314391,
1516318673, 1516235361, 1516237613), tzone = "", class = c("POSIXct",
"POSIXt")), id = c(1, 1, 2, 2)), .Names = c("start", "end", "id"
), row.names = c(NA, -4L), class = "data.frame"))
intervals <-
structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L),
time = structure(c(1516311067, 1516311667, 1516312267, 1516312867,
1516313467, 1516314067, 1516314667, 1516315268, 1516315868,
1516316468, 1516317068, 1516317671, 1516318267, 1516318869,
1516319467, 1516233666, 1516234266, 1516234866, 1516235465,
1516236066, 1516236666, 1516237266, 1516237865, 1516238465,
1516239065), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
available = c("yes", "yes", "yes", "yes", "yes", "no", "yes",
"yes", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes",
"yes", "yes", "yes", "no", "no", "no", "yes", "yes", "yes"
), charge = c(83L, 83L, 83L, 83L, 83L, 83L, 81L, 81L, 81L,
81L, 81L, 81L, 81L, 79L, 79L, 84L, 84L, 84L, 80L, 80L, 80L,
80L, 80L, 80L, 80L)), .Names = c("id", "time", "available",
"charge"), row.names = c(NA, -25L), class = "data.frame")
您可以使用 data.table non-equi 查找最近的 startCharge 和 endCharge 如下：
setDT(testScooter)
setDT(intervals)
testScooter[, startCharge := intervals[testScooter, .SD[, charge[.N], by=.(id, start)], on=.(id, time < start)]$V1]
testScooter[, endCharge := intervals[testScooter, .SD[, charge[1L], by=.(id, end)], on=.(id, time > end)]$V1]
startCharge 的解释：
对于内部方括号：
intervals[testScooter, .SD[, charge[.N], by=.(id, start)], on=.(id, time < start)]
您正在执行 non-equi 连接，这样 intervals' id 匹配 testScooter 的 id 和 intervals 中的 time 是在 testScooter 中的 start 之前。
和.SD[, charge[.N], by=.(id, start)]组按id和start和return最新的intervals'time在每个组的[=21=之前].
与 endCharge 类似。
新答案：
您可以使用双滚动连接来做到这一点：
testScooter[, startCharge := intervals[testScooter, on = .(id, time = start), roll = Inf, x.charge]
][, endCharge := intervals[testScooter, on = .(id, time = end), roll = -Inf, x.charge]][]
给出了想要的结果：
start end id startCharge endCharge
1: 2018-01-18 23:19:13 2018-01-18 23:26:31 1 83 81
2: 2018-01-19 00:29:22 2018-01-19 00:37:53 1 81 79
3: 2018-01-18 01:22:02 2018-01-18 01:29:21 2 84 80
4: 2018-01-18 01:37:52 2018-01-18 02:06:53 2 80 80
这是做什么的：
roll = Inf 查找 intervals 中 startroll = -Inf 在 endintervals 中的第一个观察值
另请参阅注释，了解为什么新答案更好。
旧答案：
testScooter[intervals, on = .(id, start = time), roll = -Inf, startCharge := i.charge
][intervals, on = .(id, end = time), roll = Inf, endCharge := i.charge][]
注：
正如@Frank 指出的那样，here on Github、data.table returns 是 i 中的最后一场比赛，当有多个比赛时，旧答案就是这种情况。当代码为 运行 with verbose = TRUE:
时，请参阅以下输出
> testScooter[intervals, on = .(id, start = time), roll = -Inf, startCharge := i.charge, verbose = TRUE][]
Calculated ad hoc index in 0 secs
Starting bmerge ...done in 0 secs
Detected that j uses these columns: startCharge,i.charge
Assigning to 16 row subset of 4 rows
start end id startCharge
1: 2018-01-18 22:19:13 2018-01-18 22:26:31 1 83
2: 2018-01-18 23:29:22 2018-01-18 23:37:53 1 81
3: 2018-01-18 00:22:02 2018-01-18 00:29:21 2 84
4: 2018-01-18 00:37:52 2018-01-18 01:06:53 2 80
尽管此行为在此示例中不会导致任何问题，但效率较低并且可能会导致意外结果。请参阅此示例（由@Frank 提供）：
> data.table(a = 1:2)[data.table(a = c(2L, 2L), v = 3:4), on=.(a), v := i.v, verbose = TRUE][]
Calculated ad hoc index in 0 secs
Starting bmerge ...done in 0 secs
Detected that j uses these columns: v,i.v
Assigning to 2 row subset of 2 rows
a v
1: 1 NA
2: 2 4
因此，新答案是更好的选择。
已用数据：
testScooter <- structure(list(start = structure(c(1516313953, 1516318162, 1516234922, 1516235872), tzone = "UTC", class = c("POSIXct", "POSIXt")),
end = structure(c(1516314391, 1516318673, 1516235361, 1516237613), tzone = "UTC", class = c("POSIXct", "POSIXt")),
id = c(1L, 1L, 2L, 2L)),
.Names = c("start", "end", "id"), row.names = c(NA, -4L), class = "data.frame")
setDT(testScooter)
intervals <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L),
time = structure(c(1516311067, 1516311667, 1516312267, 1516312867, 1516313467, 1516314067, 1516314667, 1516315268, 1516315868, 1516316468, 1516317068, 1516317671, 1516318267, 1516318869, 1516319467, 1516233666, 1516234266, 1516234866, 1516235465, 1516236066, 1516236666, 1516237266, 1516237865, 1516238465, 1516239065), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
available = c("yes", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes", "yes", "yes", "yes", "no", "no", "no", "yes", "yes", "yes"),
charge = c(83L, 83L, 83L, 83L, 83L, 83L, 81L, 81L, 81L, 81L, 81L, 81L, 81L, 79L, 79L, 84L, 84L, 84L, 80L, 80L, 80L, 80L, 80L, 80L, 80L)),
.Names = c("id", "time", "available", "charge"), row.names = c(NA, -25L), class = "data.frame")
setDT(intervals)
这是 non-R（蹩脚的）解决方案：
#Convert to data table
testScooter <- data.table(testScooter)
intervals <- data.table(intervals)
#Dummy data frame to store the results which we will finally
chargeDF <- data.frame(startCharge = numeric(),endCharge = numeric())
#Loop for each Unique ID
for( i in unique(intervals$id)){
newScooter <- testScooter[id == i,]
newintervals <- intervals[id == i,]
#Check if start time in intervals DF less than time in testScooter
tempStartList <- lapply(newScooter[,start], function (x) { newintervals[,time] < x})
#Check if end time in intervals DF greater than time in testScooter
tempEndList <- lapply(newScooter[,end], function (x) { newintervals[,time] > x})
#Loop through each row for a particular ID
for( j in 1:nrow(newScooter)){
#Find the value just before the condition becomes false
scharge <- tail(newintervals$charge[tempStartList[[j]]],1)
#Find the value just after the condition becomes true
echarge <- head(newintervals$charge[tempEndList[[j]]],1)
#Bind the results to the dummy df created earlier
chargeDF <- rbind(chargeDF,data.frame(startCharge = scharge,endCharge = echarge))
}
}
output <- cbind(testScooter, chargeDF)
我的objective是将两个数据table根据时间和dplyr或data.table进行join，具体是获取事件前后的记录.
在示例数据中，本例中的事件是踏板车旅行。以下是四次旅行 - 两次由滑板车 1 进行，两次由滑板车 2 进行。
> testScooter
start end id
1: 2018-01-18 22:19:13 2018-01-18 22:26:31 1
2: 2018-01-18 23:29:22 2018-01-18 23:37:53 1
3: 2018-01-18 00:22:02 2018-01-18 00:29:21 2
4: 2018-01-18 00:37:52 2018-01-18 01:06:53 2
在单独的 table 中，记录的间隔几乎相等。 ids 匹配并且踏板车在旅行中被标记为 no。
> intervals
id time available charge
1 1 2018-01-18 21:31:07 yes 83
2 1 2018-01-18 21:41:07 yes 83
3 1 2018-01-18 21:51:07 yes 83
4 1 2018-01-18 22:01:07 yes 83
5 1 2018-01-18 22:11:07 yes 83
6 1 2018-01-18 22:21:07 no 83
7 1 2018-01-18 22:31:07 yes 81
8 1 2018-01-18 22:41:08 yes 81
9 1 2018-01-18 22:51:08 yes 81
10 1 2018-01-18 23:01:08 yes 81
11 1 2018-01-18 23:11:08 yes 81
12 1 2018-01-18 23:21:11 yes 81
13 1 2018-01-18 23:31:07 no 81
14 1 2018-01-18 23:41:09 yes 79
15 1 2018-01-18 23:51:07 yes 79
16 2 2018-01-18 00:01:06 yes 84
17 2 2018-01-18 00:11:06 yes 84
18 2 2018-01-18 00:21:06 yes 84
19 2 2018-01-18 00:31:05 yes 80
20 2 2018-01-18 00:41:06 no 80
21 2 2018-01-18 00:51:06 no 80
22 2 2018-01-18 01:01:06 no 80
23 2 2018-01-18 01:11:05 yes 80
24 2 2018-01-18 01:21:05 yes 80
25 2 2018-01-18 01:31:05 yes 80
我尝试生成的输出如下。
> output
start end id startCharge endCharge
1: 2018-01-18 22:19:13 2018-01-18 22:26:31 1 83 81
2: 2018-01-18 23:29:22 2018-01-18 23:37:53 1 81 79
3: 2018-01-18 00:22:02 2018-01-18 00:29:21 2 84 80
4: 2018-01-18 00:37:52 2018-01-18 01:06:53 2 80 80
关于如何在时间范围之前和之后的最近时间进行匹配的任何建议都会有所帮助，也许可以使用 data.table 包中的 lubridate::new_interval() 或 roll='nearest' 但我不是确定从哪里开始。
# Here is the sample data
library(data.table)
testScooter <- setDT(
structure(list(start = structure(c(1516313953, 1516318162, 1516234922,
1516235872), tzone = "", class = c("POSIXct", "POSIXt")), end = structure(c(1516314391,
1516318673, 1516235361, 1516237613), tzone = "", class = c("POSIXct",
"POSIXt")), id = c(1, 1, 2, 2)), .Names = c("start", "end", "id"
), row.names = c(NA, -4L), class = "data.frame"))
intervals <-
structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L,
1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L),
time = structure(c(1516311067, 1516311667, 1516312267, 1516312867,
1516313467, 1516314067, 1516314667, 1516315268, 1516315868,
1516316468, 1516317068, 1516317671, 1516318267, 1516318869,
1516319467, 1516233666, 1516234266, 1516234866, 1516235465,
1516236066, 1516236666, 1516237266, 1516237865, 1516238465,
1516239065), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
available = c("yes", "yes", "yes", "yes", "yes", "no", "yes",
"yes", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes",
"yes", "yes", "yes", "no", "no", "no", "yes", "yes", "yes"
), charge = c(83L, 83L, 83L, 83L, 83L, 83L, 81L, 81L, 81L,
81L, 81L, 81L, 81L, 79L, 79L, 84L, 84L, 84L, 80L, 80L, 80L,
80L, 80L, 80L, 80L)), .Names = c("id", "time", "available",
"charge"), row.names = c(NA, -25L), class = "data.frame")
您可以使用 data.table non-equi 查找最近的 startCharge 和 endCharge 如下：
setDT(testScooter)
setDT(intervals)
testScooter[, startCharge := intervals[testScooter, .SD[, charge[.N], by=.(id, start)], on=.(id, time < start)]$V1]
testScooter[, endCharge := intervals[testScooter, .SD[, charge[1L], by=.(id, end)], on=.(id, time > end)]$V1]
startCharge 的解释：
对于内部方括号：
intervals[testScooter, .SD[, charge[.N], by=.(id, start)], on=.(id, time < start)]
您正在执行 non-equi 连接，这样 intervals' id 匹配 testScooter 的 id 和 intervals 中的 time 是在 testScooter 中的 start 之前。
和.SD[, charge[.N], by=.(id, start)]组按id和start和return最新的intervals'time在每个组的[=21=之前].
与 endCharge 类似。
新答案：
您可以使用双滚动连接来做到这一点：
testScooter[, startCharge := intervals[testScooter, on = .(id, time = start), roll = Inf, x.charge]
][, endCharge := intervals[testScooter, on = .(id, time = end), roll = -Inf, x.charge]][]
给出了想要的结果：
start end id startCharge endCharge 1: 2018-01-18 23:19:13 2018-01-18 23:26:31 1 83 81 2: 2018-01-19 00:29:22 2018-01-19 00:37:53 1 81 79 3: 2018-01-18 01:22:02 2018-01-18 01:29:21 2 84 80 4: 2018-01-18 01:37:52 2018-01-18 02:06:53 2 80 80
这是做什么的：
roll = Inf查找intervals中start 之前的最后一次观察
roll = -Inf在end 之后查找
intervals 中的第一个观察值
另请参阅注释，了解为什么新答案更好。
旧答案：
testScooter[intervals, on = .(id, start = time), roll = -Inf, startCharge := i.charge
][intervals, on = .(id, end = time), roll = Inf, endCharge := i.charge][]
注：
正如@Frank 指出的那样，here on Github、data.table returns 是 i 中的最后一场比赛，当有多个比赛时，旧答案就是这种情况。当代码为 运行 with verbose = TRUE:
> testScooter[intervals, on = .(id, start = time), roll = -Inf, startCharge := i.charge, verbose = TRUE][]
Calculated ad hoc index in 0 secs
Starting bmerge ...done in 0 secs
Detected that j uses these columns: startCharge,i.charge
Assigning to 16 row subset of 4 rows
start end id startCharge
1: 2018-01-18 22:19:13 2018-01-18 22:26:31 1 83
2: 2018-01-18 23:29:22 2018-01-18 23:37:53 1 81
3: 2018-01-18 00:22:02 2018-01-18 00:29:21 2 84
4: 2018-01-18 00:37:52 2018-01-18 01:06:53 2 80
尽管此行为在此示例中不会导致任何问题，但效率较低并且可能会导致意外结果。请参阅此示例（由@Frank 提供）：
> data.table(a = 1:2)[data.table(a = c(2L, 2L), v = 3:4), on=.(a), v := i.v, verbose = TRUE][]
Calculated ad hoc index in 0 secs
Starting bmerge ...done in 0 secs
Detected that j uses these columns: v,i.v
Assigning to 2 row subset of 2 rows
a v
1: 1 NA
2: 2 4
因此，新答案是更好的选择。
已用数据：
testScooter <- structure(list(start = structure(c(1516313953, 1516318162, 1516234922, 1516235872), tzone = "UTC", class = c("POSIXct", "POSIXt")),
end = structure(c(1516314391, 1516318673, 1516235361, 1516237613), tzone = "UTC", class = c("POSIXct", "POSIXt")),
id = c(1L, 1L, 2L, 2L)),
.Names = c("start", "end", "id"), row.names = c(NA, -4L), class = "data.frame")
setDT(testScooter)
intervals <- structure(list(id = c(1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 1L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L, 2L),
time = structure(c(1516311067, 1516311667, 1516312267, 1516312867, 1516313467, 1516314067, 1516314667, 1516315268, 1516315868, 1516316468, 1516317068, 1516317671, 1516318267, 1516318869, 1516319467, 1516233666, 1516234266, 1516234866, 1516235465, 1516236066, 1516236666, 1516237266, 1516237865, 1516238465, 1516239065), class = c("POSIXct", "POSIXt"), tzone = "UTC"),
available = c("yes", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes", "yes", "yes", "yes", "no", "yes", "yes", "yes", "yes", "yes", "yes", "no", "no", "no", "yes", "yes", "yes"),
charge = c(83L, 83L, 83L, 83L, 83L, 83L, 81L, 81L, 81L, 81L, 81L, 81L, 81L, 79L, 79L, 84L, 84L, 84L, 80L, 80L, 80L, 80L, 80L, 80L, 80L)),
.Names = c("id", "time", "available", "charge"), row.names = c(NA, -25L), class = "data.frame")
setDT(intervals)
这是 non-R（蹩脚的）解决方案：
#Convert to data table
testScooter <- data.table(testScooter)
intervals <- data.table(intervals)
#Dummy data frame to store the results which we will finally
chargeDF <- data.frame(startCharge = numeric(),endCharge = numeric())
#Loop for each Unique ID
for( i in unique(intervals$id)){
newScooter <- testScooter[id == i,]
newintervals <- intervals[id == i,]
#Check if start time in intervals DF less than time in testScooter
tempStartList <- lapply(newScooter[,start], function (x) { newintervals[,time] < x})
#Check if end time in intervals DF greater than time in testScooter
tempEndList <- lapply(newScooter[,end], function (x) { newintervals[,time] > x})
#Loop through each row for a particular ID
for( j in 1:nrow(newScooter)){
#Find the value just before the condition becomes false
scharge <- tail(newintervals$charge[tempStartList[[j]]],1)
#Find the value just after the condition becomes true
echarge <- head(newintervals$charge[tempEndList[[j]]],1)
#Bind the results to the dummy df created earlier
chargeDF <- rbind(chargeDF,data.frame(startCharge = scharge,endCharge = echarge))
}
}
output <- cbind(testScooter, chargeDF)