按小时聚合时间序列间隔答案

【问题标题】：Aggregate timeseries intervals by hour按小时聚合时间序列间隔
【发布时间】：2018-02-28 06:20:09
【问题描述】：

我有一个包含停车票、开始/结束时间以及购买地点（组）信息的数据集。我需要执行时间序列分析，以预测未来何时何地购买门票。为此，我需要将格式转换为时间序列格式，其中包含在给定时间点有效的票数。

我的数据样本：

library(lubridate)
timeseries <- data.frame(start = c("2016-12-31 20:42:00",
                                   "2016-12-31 21:41:00",
                                   "2016-12-31 21:15:00",
                                   "2016-12-31 17:19:00",
                                   "2016-12-31 21:47:00",
                                   "2016-12-31 16:58:00"),
                         end = c("2016-12-31 23:07:00",
                                 "2016-12-31 23:07:00",
                                 "2016-12-31 23:08:00",
                                 "2016-12-31 23:09:00",
                                 "2016-12-31 23:11:00",
                                 "2016-12-31 23:11:00"),
                         group = c(1,2,1,2,1,2),
                         stringsAsFactors = FALSE)
timeseries$start <- as.POSIXlt(timeseries$start)
timeseries$end <- as.POSIXlt(timeseries$end)
timeseries$interval <- interval(timeseries$start, timeseries$end, tzone="UTC")

我想在（按组）中汇总信息的时间段示例：

summary_hours <- data.frame(timeStart = c("2016-12-31 16:00",
                                          "2016-12-31 17:00",
                                          "2016-12-31 18:00",
                                          "2016-12-31 19:00",
                                          "2016-12-31 20:00",
                                          "2016-12-31 21:00",
                                          "2016-12-31 22:00",
                                          "2016-12-31 23:00"),
                            timeEnd = c("2016-12-31 17:00",
                                        "2016-12-31 18:00",
                                        "2016-12-31 19:00",
                                        "2016-12-31 20:00",
                                        "2016-12-31 21:00",
                                        "2016-12-31 22:00",
                                        "2016-12-31 23:00",
                                        "2017-01-01 00:00"))
summary_hours$timeStart <- as.POSIXlt(summary_hours$timeStart)
summary_hours$timeEnd <- as.POSIXlt(summary_hours$timeEnd)
summary_hours$interval <- interval(summary_hours$timeStart, summary_hours$timeEnd, tzone="UTC")

当数据集跨越两年时，我目前的方法似乎非常低效。

library("lubridate")
intersect_in_mins <- function(interval) {
  return(as.period(intersect(interval, summary_hours$interval), "minutes")@minute)
}

summary_hours$group1 <- rowSums(t(do.call(rbind, lapply(subset(timeseries, group == 1)$interval, intersect_in_mins))), na.rm = TRUE)
summary_hours$group2 <- rowSums(t(do.call(rbind, lapply(subset(timeseries, group == 2)$interval, intersect_in_mins))), na.rm = TRUE)

summary_hours
            timeStart             timeEnd                                         interval group1 group2
1 2016-12-31 16:00:00 2016-12-31 17:00:00 2016-12-31 16:00:00 UTC--2016-12-31 17:00:00 UTC      0      2
2 2016-12-31 17:00:00 2016-12-31 18:00:00 2016-12-31 17:00:00 UTC--2016-12-31 18:00:00 UTC      0    101
3 2016-12-31 18:00:00 2016-12-31 19:00:00 2016-12-31 18:00:00 UTC--2016-12-31 19:00:00 UTC      0    120
4 2016-12-31 19:00:00 2016-12-31 20:00:00 2016-12-31 19:00:00 UTC--2016-12-31 20:00:00 UTC      0    120
5 2016-12-31 20:00:00 2016-12-31 21:00:00 2016-12-31 20:00:00 UTC--2016-12-31 21:00:00 UTC     18    120
6 2016-12-31 21:00:00 2016-12-31 22:00:00 2016-12-31 21:00:00 UTC--2016-12-31 22:00:00 UTC    118    139
7 2016-12-31 22:00:00 2016-12-31 23:00:00 2016-12-31 22:00:00 UTC--2016-12-31 23:00:00 UTC    180    180
8 2016-12-31 23:00:00 2017-01-01 00:00:00 2016-12-31 23:00:00 UTC--2017-01-01 00:00:00 UTC     26     27

你有什么好的图书馆可以自动完成这种魔法的建议吗？

【问题讨论】：

标签： r time-series grouping aggregate lubridate

【解决方案1】：

在他的 cmets here 和 here 中，OP 改变了问题的目标。现在，请求是为每个一小时的时间间隔汇总“活动工单的分钟数”。

这需要一种完全不同的方法，这有理由发布单独的答案，恕我直言。

要检查哪些票证在一小时的哪个时间间隔内处于活动状态，可以使用 data.table 包中的 foverlaps() 函数：

library(data.table)
# IMPORTANT for reproducibility in different timezones
Sys.setenv(TZ = "UTC")
# convert timestamps from character to POSIXct
cols <- c("start", "end")
setDT(timeseries)[, (cols) := lapply(.SD, fasttime::fastPOSIXct), .SDcols = cols]

# create sequence of intervals of one hour covering all given times
hours_seq <- timeseries[, {
  tmp <- seq(lubridate::floor_date(min(start, end), "hour"),
             lubridate::ceiling_date(max(start, end), "hour"), 
             by = "1 hour")
  .(start = head(tmp, -1L), end = tail(tmp, -1L))
  }]
hours_seq

                 start                 end
1: 2016-12-31 16:00:00 2016-12-31 17:00:00
2: 2016-12-31 17:00:00 2016-12-31 18:00:00
3: 2016-12-31 18:00:00 2016-12-31 19:00:00
4: 2016-12-31 19:00:00 2016-12-31 20:00:00
5: 2016-12-31 20:00:00 2016-12-31 21:00:00
6: 2016-12-31 21:00:00 2016-12-31 22:00:00
7: 2016-12-31 22:00:00 2016-12-31 23:00:00
8: 2016-12-31 23:00:00 2017-01-01 00:00:00

# split up given ticket intervals in hour pieces 
foverlaps(hours_seq, setkey(timeseries, start, end), nomatch = 0L)[
  # compute active minutes and aggregate
  , .(cnt_active_tickets = .N, 
      sum_active_minutes = sum(as.integer(
        difftime(pmin(end, i.end), pmax(start, i.start), units = "mins")))), 
    keyby = .(group, interval_start = i.start, interval_end = i.end)]

    group      interval_start        interval_end cnt_active_tickets sum_active_minutes
 1:     1 2016-12-31 20:00:00 2016-12-31 21:00:00                  1                 18
 2:     1 2016-12-31 21:00:00 2016-12-31 22:00:00                  3                118
 3:     1 2016-12-31 22:00:00 2016-12-31 23:00:00                  3                180
 4:     1 2016-12-31 23:00:00 2017-01-01 00:00:00                  3                 26
 5:     2 2016-12-31 16:00:00 2016-12-31 17:00:00                  1                  2
 6:     2 2016-12-31 17:00:00 2016-12-31 18:00:00                  2                101
 7:     2 2016-12-31 18:00:00 2016-12-31 19:00:00                  2                120
 8:     2 2016-12-31 19:00:00 2016-12-31 20:00:00                  2                120
 9:     2 2016-12-31 20:00:00 2016-12-31 21:00:00                  2                120
10:     2 2016-12-31 21:00:00 2016-12-31 22:00:00                  3                139
11:     2 2016-12-31 22:00:00 2016-12-31 23:00:00                  3                180
12:     2 2016-12-31 23:00:00 2017-01-01 00:00:00                  3                 27

请注意，此方法还考虑“短期停车者”，即有效时间不到一小时并在整个小时之后开始并在下一个完整小时之前结束的票。

宽格式输出

如果结果应该并排显示每个group 的值，则可以使用dcast() 将数据从长格式重新调整为宽格式：

foverlaps(hours_seq, setkey(timeseries, start, end), nomatch = 0L)[
  , active_minutes := as.integer(
    difftime(pmin(end, i.end), pmax(start, i.start), units = "mins"))][
      , dcast(.SD, i.start + i.end ~ paste0("group", group), sum)]

               i.start               i.end group1 group2
1: 2016-12-31 16:00:00 2016-12-31 17:00:00      0      2
2: 2016-12-31 17:00:00 2016-12-31 18:00:00      0    101
3: 2016-12-31 18:00:00 2016-12-31 19:00:00      0    120
4: 2016-12-31 19:00:00 2016-12-31 20:00:00      0    120
5: 2016-12-31 20:00:00 2016-12-31 21:00:00     18    120
6: 2016-12-31 21:00:00 2016-12-31 22:00:00    118    139
7: 2016-12-31 22:00:00 2016-12-31 23:00:00    180    180
8: 2016-12-31 23:00:00 2017-01-01 00:00:00     26     27

【讨论】：

如果您认为 OP 帖子没有准确反映问题，您应该编辑它或要求 OP 发帖人这样做（或者只是要求他们发布新的 q），我认为，而不是而不是将 cmets 视为问题的一部分。正如他们在 meta 上所说的那样，“评论是短暂的”等。
对不起，我试着举个例子，说明我所说的“活跃票”是“活跃票的分钟数”。

【解决方案2】：

OP 已请求计算在给定时间点有多少票有效。

这可以使用开始和结束日期的non-equi join 以及固定的每小时时间点的连续序列来实现：

library(data.table)
# IMPORTANT for reproducibility in different timezones
Sys.setenv(TZ = "UTC")

# convert timestamps from character to POSIXct
cols <- c("start", "end")
setDT(timeseries)[, (cols) := lapply(.SD, fasttime::fastPOSIXct), .SDcols = cols]
# add id to each row (required to count the active tickets later)
timeseries[, rn := .I]
# print data for ilustration
timeseries[order(group, start, end)]

                 start                 end group rn
1: 2016-12-31 20:42:00 2016-12-31 23:07:00     1  1
2: 2016-12-31 21:15:00 2016-12-31 23:08:00     1  3
3: 2016-12-31 21:47:00 2016-12-31 23:11:00     1  5
4: 2016-12-31 16:58:00 2016-12-31 23:11:00     2  6
5: 2016-12-31 17:19:00 2016-12-31 23:09:00     2  4
6: 2016-12-31 21:41:00 2016-12-31 23:07:00     2  2

# create sequence of hourly timepoints
hours_seq <- timeseries[, seq(lubridate::floor_date(min(start, end), "hour"),
                              lubridate::ceiling_date(max(start, end), "hour"), 
                              by = "1 hour")]
hours_seq

[1] "2016-12-31 16:00:00 UTC" "2016-12-31 17:00:00 UTC" "2016-12-31 18:00:00 UTC" "2016-12-31 19:00:00 UTC"
[5] "2016-12-31 20:00:00 UTC" "2016-12-31 21:00:00 UTC" "2016-12-31 22:00:00 UTC" "2016-12-31 23:00:00 UTC"
[9] "2017-01-01 00:00:00 UTC"

# non-equi join
timeseries[.(hr = hours_seq), on = .(start <= hr, end > hr), nomatch = 0L,
           allow.cartesian = TRUE][
             # count number of active tickets at timepoint and by group
             , .(n.active.tickets = uniqueN(rn)), keyby = .(group, timepoint = start)]

    group           timepoint n.active.tickets
 1:     1 2016-12-31 21:00:00                1
 2:     1 2016-12-31 22:00:00                3
 3:     1 2016-12-31 23:00:00                3
 4:     2 2016-12-31 17:00:00                1
 5:     2 2016-12-31 18:00:00                2
 6:     2 2016-12-31 19:00:00                2
 7:     2 2016-12-31 20:00:00                2
 8:     2 2016-12-31 21:00:00                2
 9:     2 2016-12-31 22:00:00                3
10:     2 2016-12-31 23:00:00                3

【讨论】：

感谢您的建议，看起来很有希望。我可以看到我需要阅读一下 data.table 语法。在与一位同事讨论停车后，我们得出的结论是，每个时间段最好有“有效票的分钟数”，而不是“有效票的数量”。这很容易在您的代码中实现吗？
以上代码统计了一个时间实例 (timepoint) 的活跃票数，例如“5 点钟有多少停车位被占用？” .通过timepoint 汇总票证的总持续时间在技术上是可行的，但对我来说没有意义。恕我直言，那么最好按时间间隔聚合。让我看看我能做什么。
阅读data.table 的好起点是github.com/Rdatatable/data.table/wiki/Getting-started 上的小插曲和弗兰克出色的Quick R Tutorial。
也许我的问题不够清楚。我想为每个小时的时间间隔汇总“活动票的分钟数”。感谢 data.table 参考，我会调查一下。