基于xts的10分钟数据按小时聚合：缺失值过滤后计算均值

我有一个存储10分钟粒度数据的大型xts对象，需将其按小时聚合计算均值。数据存在部分缺失值，要求仅对数据完整性＞50%的小时计算均值，完整性＜50%的小时替换为NA，请问如何实现？

示例数据 #

library(lubridate)
library(xts)
set.seed(1001)
starttime <- ydm_hms('2001-01-01 10:00:00')
endtime <- ydm_hms('2001-01-01 12:50:00')
timevec <- seq(starttime,endtime,by='10 min')
data <- data.frame(replicate(2,sample(0:10,length(timevec),rep=TRUE)))
datana <- as.matrix(data)
datana[sample(seq_along(datana),0.4*length(datana))] <- NA
dat_na <- as.data.frame(datana)|> type.convert(as.is=TRUE)
dat_natime <- cbind(time=timevec,dat_na)
xtsdatna <- xts(dat_natime,order.by = dat_natime$time)

借助xts包的period.apply()和endpoints()函数即可实现，核心逻辑是按小时分组后，先判断每组数据的完整性，再决定计算均值还是返回NA。

具体代码如下：

# 生成按小时分组的索引端点
hour_endpoints <- endpoints(xtsdatna, on = "hours")

# 自定义聚合函数：先校验完整性，再计算结果
agg_func <- function(x) {
  # 统计每列非缺失值数量
  non_na_count <- colSums(!is.na(x[, c("X1", "X2")]))
  # 设定完整性阈值：每组数据量的50%
  threshold <- nrow(x) * 0.5
  # 计算列均值（忽略NA），不满足条件的列设为NA
  mean_vals <- colMeans(x[, c("X1", "X2")], na.rm = TRUE)
  mean_vals[non_na_count <= threshold] <- NA
  # 保留每组起始时间作为小时标记
  cbind(time = first(x$time), as.data.frame(t(mean_vals)))
}

# 执行小时级聚合
hourly_agg <- period.apply(xtsdatna, hour_endpoints, agg_func)

# 转换为数据框查看最终结果
result <- do.call(rbind, hourly_agg)
print(result)

代码说明 #

• endpoints(xtsdatna, on = "hours")：拆分xts数据的小时级索引，用于分组。
• 自定义agg_func：
  1. 统计每组中各列的非缺失值数量；
  2. 以每组数据量的50%作为完整性阈值（本例中每小时6个10分钟数据，阈值为3）；
  3. 先计算列均值，再将非缺失值占比不足50%的列替换为NA；
  4. 取每组的第一个时间点作为该小时的标记。
• period.apply()：将拆分后的每组数据传入自定义函数完成聚合计算。

预期结果 #

运行代码后输出如下：

time   X1   X2
1 2001-01-01 10:00:00 4.50 6.20
2 2001-01-01 11:00:00   NA 8.00
3 2001-01-01 12:00:00 6.25 4.67

内容的提问来源于stack exchange，提问作者johnnyg