代码之家 › 专栏 › 技术社区 › Esben Eickhardt

按小时聚合时间序列间隔

lubridate aggregate grouping time-series r

Esben Eickhardt · 技术社区 · 8 年前

我的数据示例:

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

你有什么好的库可以自动完成这种魔术的建议吗?

2 回复 | 直到 8 年前

Uwe 8 年前

在他的评论中 here here ,OP改变了问题的目的。现在,请求是 .

这需要一种完全不同的方法,证明可以发布一个单独的答案,IMHO。

要检查哪些票据在一小时的时间间隔内处于活动状态,请 foverlaps() 来自的函数 data.table 包装可用于:

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

Uwe 8 年前

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