将时间序列聚合为长度/N 个点

Question

我有不同长度的时间序列（通常为 1 到 14 天），样本之间的间隔为 15 秒。我需要使用带有一些预定义函数（中值、最小值、最大值等）的聚合为每个组保留所有数据的 N 点。原因 - 我想在绘图上显示它并且太多的点会造成混乱，最好拆分数据并显示中位数，或短时间间隔的最小值/最大值。

问题是，如果我使用 lubridate ceiling_date 函数进行聚合，我的聚合期真的很有限。它仅支持“N hours”或“N mins”格式，甚至不支持“75m”或“1500s”或“1 hours 5 mins”。

但我真正需要的是 - 将我的数据长度除以 N 并以秒为单位计算聚合间隔。假设我的数据长度是 8.68 天 = 8.682460*60 = 749952 秒。假设我想要200分。我的聚合周期应该是 749952/200 = 3749,76 ~ 3750 秒。但我必须用“2小时”来代替它。

这是我的示例数据代码：

library(dplyr)
library(lubridate)

set.seed(900)

data1 <- 
data.frame(
datetime = seq.POSIXt(as.POSIXct("2020-12-26 10:00:00"), as.POSIXct("2020-12-26 10:00:00") + 15*50001, "15 sec"),
Value = sample(1:100, 50002, replace = T),
Instance = "C:"
)

data2 <- data.frame(
  datetime = seq.POSIXt(as.POSIXct("2020-12-26 10:00:00"), as.POSIXct("2020-12-26 10:00:00") + 15*50001, "15 sec"),
  Value = sample(1:100, 50002, replace = T),
  Instance = "D:"
)

data <- rbind (data1, data2) %>% arrange(datetime)

data_lenght <-
  difftime(max(data$datetime), min(data$datetime), units = "secs")

agg_interval <- data_lenght / 200


if (agg_interval > 3600) {
  N_hours <- ceiling(agg_interval / 60 / 60)
  agg_period <- paste0(N_hours, " hours")
} else {
  N_minutes <- ceiling(agg_interval / 60)
  agg_period <- paste0(N_minutes, " mins")
}

agg_data <-
  data %>%  group_by(across(-c(Value, datetime)),  datetime = ceiling_date (datetime, agg_period)) %>%
  summarise (Value = median(Value) , .groups = "drop")

结果：

# A tibble: 212 x 3
   Instance datetime            Value
   <chr>    <dttm>              <dbl>
 1 C:       2020-12-26 10:00:00  85  
 2 C:       2020-12-26 12:00:00  53  
 3 C:       2020-12-26 14:00:00  48.5
 4 C:       2020-12-26 16:00:00  50  
 5 C:       2020-12-26 18:00:00  52  
 6 C:       2020-12-26 20:00:00  50.5
 7 C:       2020-12-26 22:00:00  51  
 8 C:       2020-12-27 00:00:00  48  
 9 C:       2020-12-27 02:00:00  47  
10 C:       2020-12-27 04:00:00  47  
# ... with 202 more rows

另一个问题，稍后在我的代码中，我需要将聚合周期转换为秒。但它是文本：“15 分钟”、“55 分钟”、“3 小时”等。真的很难处理。

有没有比我使用秒作为整数而不是像我这样的文本更简单的方法来进行聚合？

更新：如果我尝试以秒为单位使用间隔：

agg_interval <- round (data_lenght / 200 / 15) * 15

agg_period <- paste0(agg_interval, " secs")

agg_data <-
  data %>%  group_by(across(-c(Value, datetime)),  datetime = ceiling_date (datetime, agg_period)) %>%
  summarise (Value = median(Value) , .groups = "drop")

结果是 - 没有发生聚合：

# A tibble: 50,004 x 3
   Instance datetime            Value
   <chr>    <dttm>              <int>
 1 C:       2020-12-26 10:00:00    85
 2 C:       2020-12-26 10:01:00    19
 3 C:       2020-12-26 10:02:00    43
 4 C:       2020-12-26 10:03:00    83
 5 C:       2020-12-26 10:04:00    67
 6 C:       2020-12-26 10:05:00    28
 7 C:       2020-12-26 10:06:00    54
 8 C:       2020-12-26 10:07:00    28
 9 C:       2020-12-26 10:08:00    99
10 C:       2020-12-26 10:09:00    54
# ... with 49,994 more rows

Answer 1

cut.POSIXt 可以这样使用，允许任意秒数。

secs <- 7200
as.POSIXt(cut(data$datetime, paste(secs, "secs")) + secs

检查我们有：

identical(cut(data$datetime, "7200 secs"), cut(data$datetime, "2 hours"))
## [1] TRUE

正如您无疑已经注意到的，很遗憾，这不适用于 ceiling_date：

identical(ceiling_date(data$datetime, "2 hours"), 
  ceiling_date(data$datetime, "7200 secs"))
## [1] FALSE

示例

secs <- 3750
agg_period <- paste(secs, "secs")

agg_data <- data %>%  
    group_by(across(-c(Value, datetime)),  
      datetime = as.POSIXct(cut(datetime, agg_period)) + secs) %>%
    summarise (Value = median(Value) , .groups = "drop")

dim(agg_data)
## [1] 402   3

Answer 2

即使您使用POSIXt，也不需要您使用类似"3 hours" 的排序，您也可以指定length.out=。这是一种方法。

首先，为每个组创建一个时间范围，然后对所有内容进行分组。

library(dplyr)
N <- 200
newdata1 <- data %>%
  group_by(Instance) %>%
  summarize(datetime = seq(min(datetime), max(datetime), length.out = N)) %>%
  nest_by(.key = "newtimes") %>%
  ungroup()
newdata2 <- data %>%
  nest_by(Instance, .key = "olddata") %>%
  ungroup()

newdata1
# # A tibble: 2 x 2
#   Instance           newtimes
#   <chr>    <list<tbl_df[,1]>>
# 1 C:                [200 x 1]
# 2 D:                [200 x 1]
newdata2
# # A tibble: 2 x 2
#   Instance            olddata
#   <chr>    <list<tbl_df[,2]>>
# 1 C:             [50,002 x 2]
# 2 D:             [50,002 x 2]

现在我们可以approx 进行插值：

newdata <- left_join(newdata1, newdata2, by = "Instance") %>%
  mutate(newdata = purrr::map2(newtimes, olddata, ~ tibble(newvalue = approx(.y$datetime, .y$Value, xout = .x$datetime)$y))) %>%
  select(-olddata) %>%
  unnest(c(newtimes, newdata))

newdata
# # A tibble: 400 x 3
#    Instance datetime            newvalue
#    <chr>    <dttm>                 <dbl>
#  1 C:       2020-12-26 10:00:00    85   
#  2 C:       2020-12-26 11:02:48     9.22
#  3 C:       2020-12-26 12:05:37    49.2 
#  4 C:       2020-12-26 13:08:26    50.8 
#  5 C:       2020-12-26 14:11:15    92.8 
#  6 C:       2020-12-26 15:14:04    48.7 
#  7 C:       2020-12-26 16:16:53    70.4 
#  8 C:       2020-12-26 17:19:42    64.5 
#  9 C:       2020-12-26 18:22:31    41.7 
# 10 C:       2020-12-26 19:25:20    73.0 
# # ... with 390 more rows