R 在每小时槽中划分间隔

Question

可能很容易，但很难解决，在网上寻找答案，但它们通常与 cut 和快照有关，而不是间隔重叠

require(data.table)
x = data.table(start=c("2017-04-18 18:05:00","2017-04-18 18:00:00", 
"2017-04-18 21:05:00", "2017-04-18 16:05:00"), 
               end=c("2017-04-18 19:05:00","2017-04-18 21:30:00",
"2017-04-18 22:00:00", "2017-04-18 16:10:00"))

我们有 4 个观察值，我需要将其分配到相应的每小时窗口。

                 start                 end
1: 2017-04-18 18:05:00 2017-04-18 19:05:00
2: 2017-04-18 18:00:00 2017-04-18 21:30:00
3: 2017-04-18 21:05:00 2017-04-18 22:00:00
4: 2017-04-18 16:05:00 2017-04-18 16:10:00

例如，第一个在 18:00 时段有 55 分钟，在 19:00 时段有 5 分钟，下一个在 18:00、19:00、20:00 和 21:00 有 60 分钟，第三个在 21:00 有 55 分钟，最后一个在 16:00 有 5 分钟

结果应该如下（对不起，如果我把基本的手动添加错了；）

              interval   Q
1: 2017-04-18 16:00:00 5
2: 2017-04-18 17:00:00 0
3: 2017-04-18 18:00:00 115
4: 2017-04-18 19:00:00 65
5: 2017-04-18 20:00:00 120
6: 2017-04-18 21:00:00  85

当然，有一种直接的方法可以按分钟切割系列并按切割/间隔执行计数，但我相信这个问题非常普遍，它必须有一个直接的方法。最好我也有 0 值窗口，但如果需要，我可以对它们进行排序

Answer 1

这是使用dplyr的解决方案

首先定义一个辅助函数find_slots 来生成start 和end 之间的所有时间。接下来计算Q 值。

最后通过对每个槽进行分组来汇总数据。

library(dplyr)

find_slots <- function(a, b){
    slots = seq(a-minute(a)*60-second(a),
                b-minute(b)*60-second(b),
                "hour")

    dateseq = slots
    dateseq[1] = a
    r = c(dateseq, b)

    d = as.numeric(difftime(r[-1], r[-length(r)], unit = 'min'))

    data.frame(slot = slots, Q = d)
}

x %>%
    rowwise %>%
    do(find_slots(.$start, .$end)) %>%
    ungroup() %>%
    group_by(slot) %>%
    summarize(Q = sum(Q))

结果（缺少 17:00 的 0 值）：

                 slot   Q
1 2017-04-18 16:00:00   5
2 2017-04-18 18:00:00 115
3 2017-04-18 19:00:00  65
4 2017-04-18 20:00:00  60
5 2017-04-18 21:00:00  85
6 2017-04-18 22:00:00   0

编辑：使用 data.table

（也许更快，但我对 data.table 不太熟悉）

还使用fasttime 库来加快日期时间的解析。

library(fasttime)
library(data.table)

x = data.table(start=c("2017-04-18 18:05:00","2017-04-18 18:00:00", 
"2017-04-18 21:05:00", "2017-04-18 16:05:00"), 
               end=c("2017-04-18 19:05:00","2017-04-18 21:30:00",
"2017-04-18 22:00:00", "2017-04-18 16:10:00"))

find_slots2 <- function(a, b){
    a = fasttime::fastPOSIXct(a)
    b = fasttime::fastPOSIXct(b)
    slots = seq(a-data.table::minute(a)*60-data.table::second(a)*60,
                b-data.table::minute(b)*60-data.table::second(b)*60,
                "hour")

    hourseq = c(a, slots[-1], b)

    d = difftime(hourseq[-1], hourseq[-length(hourseq)], unit = 'min')

    list(slot = slots, Q = d)
}

x[, find_slots2(start, end), by = 1:nrow(x)][order(slot), .(Q = as.numeric(sum(Q))), by = slot]

Answer 2

Lubridate 有一个函数lubridate::interval() 在这里可能很有用。