Эффективные средневзвешенные по времени

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)))

Дополнительные ограничения:

• работает для интервалов, длина которых не равна двум неделям
• работает, даже если интервалы не имеют одинаковую длину(до тех пор, пока они не перекрываются)
• работает, даже если самая ранняя дата start_date не одинакова для каждого участника
• averвозраст для календарных лет, для которых этот идентификатор не подходит для завершения года, должен быть 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")]

Я предполагаю, что есть какой-то пакет для взвешивания времени, о котором я не знаю.Это правда?В идеале, есть быстрое решение для работы с данными.

Answer 1

Это в основном тот же подход, который я изложил в этом вопросе, но гораздо более эффективный, поскольку он создает длинную таблицу данных, а не матрицу.Я потратил некоторое время на поиск другого решения (которое на самом деле не включает в себя фактическое создание ячейки для каждой даты и вместо этого использует формулу средневзвешенного продукта), используя 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")]