将时间序列聚合到 length/N 个点
Aggregate timeseries to length/N points
我有不同长度的时间序列（通常为 1 到 14 天），样本之间的间隔为 15 秒。我需要使用聚合和一些预定义函数（中值、最小值、最大值等）为每个组保留所有数据的 N 点。原因 - 我想在绘图上显示它，太多的点会弄得一团糟，最好拆分数据并显示中位数，或者 min/max 短间隔。
问题是，如果我使用 lubridate ceiling_date 函数进行聚合，我的聚合周期真的很有限。它只支持“N小时”或“N分钟”格式，甚至不支持“75m”或“1500s”或“1小时5分钟”。
但我真正需要的是 - 将我的数据长度除以 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
即使您使用的是 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
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
我有不同长度的时间序列（通常为 1 到 14 天），样本之间的间隔为 15 秒。我需要使用聚合和一些预定义函数（中值、最小值、最大值等）为每个组保留所有数据的 N 点。原因 - 我想在绘图上显示它，太多的点会弄得一团糟，最好拆分数据并显示中位数，或者 min/max 短间隔。
问题是，如果我使用 lubridate ceiling_date 函数进行聚合，我的聚合周期真的很有限。它只支持“N小时”或“N分钟”格式，甚至不支持“75m”或“1500s”或“1小时5分钟”。
但我真正需要的是 - 将我的数据长度除以 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
即使您使用的是 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
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