Сумма за строки (rollapply) с расходом времени

Question

Это вопрос по вопросу, который я разместил ранее (см. Sum over rows with multiple changing conditions R data.table для получения более подробной информации). Я хочу рассчитать, сколько раз три предмета испытали событие за последние 5 лет. Так что суммировали по катящемуся окну, используя rollapply из пакета zoo. Это предполагает, что опыт 5 лет назад так же важен, как и опыт 1 год назад (такой же весовой коэффициент), поэтому теперь я хочу включить временное распад для опыта, который входит в сумму. Это в основном означает, что опыт 5 лет назад не входит в сумму с тем же весом, что и опыт 1 год назад.

В моем случае я хочу включить зависящий от возраста распад (хотя для других приложений возможны более быстрые или медленные распады, такие как квадратный корень или квадраты).

Например предположим, у меня есть следующие данные (я опирающийся на предыдущих данных для ясности):

mydf <- data.frame (Year = c(2000, 2001, 2002, 2004, 2005, 
         2007, 2000, 2001, 2002, 2003, 
         2003, 2004, 2005, 2006, 2006, 2007), 
       Name = c("Tom", "Tom", "Tom", "Fred", "Gill", 
         "Fred", "Gill", "Gill", "Tom", "Tom", 
         "Fred", "Fred", "Gill", "Fred", "Gill", "Gill")) 

# Create an indicator for the experience 
mydf$Ind <- 1 

# Load require packages 
library(data.table) 
library(zoo) 

# Set data.table 
setDT(mydf) 
setkey(mydf, Name,Year) 

# Perform cartesian join to calculate experience. I2 is the new experience indicator 
m <- mydf[CJ(unique(Name),seq(min(Year)-5, max(Year))),allow.cartesian=TRUE][, 
     list(Ind = unique(Ind), I2 = sum(Ind,na.rm=TRUE)), 
     keyby=list(Name,Year)] 

# This is the approach I have been taking so far. Note that is a simple rolling sum of I2 
m[,Exp := rollapply(I2, 5, function(x) sum(head(x,-1)), 
       align = 'right', fill=0),by=Name] 

Так вопрос теперь, как я могу включать в себя возраст зависимого распад в этот расчет. Чтобы смоделировать это, мне нужно разделить опыт на возраст опыта, прежде чем он введет сумму.

Я пытался заставить его работать, используя что-то вдоль этих линий:

m[,Exp_age := rollapply(I2, 5, function(x) sum(head(x,-1)/(tail((Year))-head(Year,-1))), 
        align = 'right', fill=0),by=Name] 

Но это не работает. Я думаю, что моя главная проблема заключается в том, что я не могу получить возраст опыта, поэтому я могу разделить его на возраст в сумме. Результат должен выглядеть Exp_age колонку в myresdata.frame ниже

myres <- data.frame(Name = c("Fred", "Fred", "Fred", "Fred", "Fred", 
         "Gill", "Gill", "Gill", "Gill", "Gill", "Gill", 
         "Tom", "Tom", "Tom", "Tom", "Tom"), 
       Year = c(2003, 2004, 2004, 2006, 2007, 2000, 2001, 2005, 
         2005, 2006, 2007, 2000, 2001, 2002, 2002, 2003), 
       Ind = c(1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1), 
       Exp = c(0, 1, 1, 3, 4, 0, 1, 1, 1, 2, 3, 0, 1, 2, 2, 4), 
       Exp_age = c(0, 1, 1, 1.333333333, 1.916666667, 0, 1, 0.45, 
          0.45, 2.2, 2, 0, 1, 1.5, 1.5, 2.833333333)) 

Все указатели будут очень признательны!

Answer 1

Если вы правильно поняли, вы пытаетесь сделать rollapply с помощью width=5 и вместо простой суммы, вы хотите сделать взвешенную сумму. Веса - это возраст опыта относительно 5-летнего окна. Я бы сделал это: сначала установите ключ в свой data.table так, чтобы он имел правильный порядок увеличения на Name, тогда вы знаете, что последний элемент в вашей переменной x является самым младшим, а первый элемент является самым старым (вы делаете это в своем коде уже). Я не могу точно сказать, к какому пути вы хотите, чтобы весы (самые младшие из них имели наибольший вес или самые старые), но вы понимаете:

setkey(m, Name, Year) 
my_fun = function(x) { w = 1:length(x); sum(x*w)} 
m[,Exp_age:=rollapply(I2, width=5, by=1, fill=NA, FUN=my_fun, by.column=FALSE, align="right") ,by=Name]