Question

给定一个包含较短间隔的数据集，并且该值表示每个间隔内某事物的平均度量，我想对每个日历年（“ 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)))

其他限制：

工作间隔不完全是两周
也可以工作参与者
没有足够期间的日历年的平均值该年份的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解决方案很快。

Answer 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")]

有效的时间加权平均值

1 个答案: