有效的时间加权平均值答案

【问题标题】：Efficient time-weighted averages有效的时间加权平均值
【发布时间】：2019-07-24 01:41:51
【问题描述】：

给定一个包含短间隔的数据集，以及一个表示每个间隔内某物的平均度量的值，我想将这些值平均到日历年，分别为每个人（“id”）。

问题在于这些间隔与日历年不一致，因此需要对这些值进行时间加权，以便从较短的间隔平均值中获得对年度平均值的最佳估计。

请注意，间隔包含开始日期，不包含结束日期。

示例数据

start_date 和 end_date 是在 id 级别内唯一不重叠的区间：

  set.seed(30)

library(lubridate)
library(data.table)
x <- CJ(id=1:5, start_date=seq(from=as.Date("2005-01-12"),by=14,length=100))

#add noise so intervals don't all start on 2005-01-12
x[,start_date:=start_date + rbinom(1,size=20,prob=.15)*15L,by=id]

#all intervals are two weeks:
x[,end_date:=start_date+14]

x[,value:=rnorm(nrow(x))]

#for each id, calculate the mean value over each calendar year. 
years <- c(year(min(x$start_date)), year(max(x$start_date)))

附加约束：

适用于不完全是两周的间隔
即使间隔长度不同（只要它们不重叠）
即使最早的 start_date 各不相同也能正常工作参与者
日历年的平均值，没有足够的周期完成这一年的 id 应该是 NA

对于我的目的来说太慢的潜在解决方案。

complete_date_seq <- seq(as.Date(ymd(paste0(years[1],"-01-01"))), as.Date(ymd(paste0(years[2],"-12-12"))),by=1)

m <- matrix(NA,nrow=length(unique(x$id)),ncol=length(complete_date_seq))
rownames(m) <- unique(x$id)
colnames(m) <- as.character(complete_date_seq)

for(i in 1:nrow(m)){
  temp <- x[id==rownames(m)[i]]
  for(j in 1:nrow(temp)){
    m[i, as.Date(complete_date_seq) %within% temp[j,interval(start_date,end_date-1)]] <- temp[j,value]
  }

}

out <- CJ(id=unique(x$id),year=years[1]:years[2])

intervalfromyear <- function(y)  interval(as.Date(ymd(paste0(y,"-01-01"))), as.Date(ymd(paste0(y,"-12-31"))))


out[, annual_avg:=mean(m[rownames(m)==.BY$id,complete_date_seq %within% intervalfromyear(.BY$year)]) ,by=c("id","year")]

我猜有一些我不知道的时间加权包。这是真的？理想情况下，有一个快速的本地 data.table 解决方案。

【问题讨论】：

标签： r data.table lubridate

【解决方案1】：

这与我在问题中提出的方法基本相同，但效率更高，因为它创建了一个长 data.table 而不是矩阵。我花了一些时间寻找使用 foverlaps 的不同解决方案（实际上并不涉及实际为每个日期创建一个单元格，而是使用加权平均乘积公式），但它的工作量更大，更不容易扩展，而且更容易出错.

#switch from exclusive to inclusive end_date
x[, actual_end_date:=as.Date(as.numeric(end_date)-1,origin="1970-01-01")]

z <- x[, list(date=seq(start_date,actual_end_date,by=1),value),by=c("id","start_date")]


complete_date_seq <- seq(from=as.Date(paste0(years[1],"-01-01")),
                         to=as.Date(paste0(years[2],"-12-31")),by=1)

missing_dates <- z[,list(date=as.Date(setdiff( complete_date_seq,date ),origin="1970-01-01"),value=NA),by=id]

result <- rbind(z,missing_dates,fill=TRUE)[order(id,date)]
result[, year:=substr(date,1,4)]
result[, mean(value),by=c("id","year")]

【讨论】：