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

Question

Это продолжение вопроса к вопросу, который я опубликовал ранее (см. Сумма по строкам с несколькими изменяющимися условиями R data.table для более подробной информации). Я хочу подсчитать, сколько раз 3 субъекта испытывали событие за последние 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]