Calculer la durée moyenne pondérée en R

Question

Je voudrais calculer la durée de vie moyenne pondérée (WAL ) d'un prêt au fil du temps dans l'affaire R. La formule pour calculer la WAL est donnée here.

J'ai les données d'exemple suivantes créées dans R.

Données d'échantillons

library(data.table) 
DT<-data.table(date=c(rep(seq(from = 2015, to = 2016.25,by = .25),2), 
seq(from = 2015, to = 2017.5,by = .5)), 
      value=c(rep(100,5), 0, 100, 80, 60, 40, 20, 0, 100, 70, 40, 30, 20, 0), 
      id=rep(c("a","b","c"),each=6)) 

DT 

     date value id 
1: 2015.00 100 a 
2: 2015.25 100 a 
3: 2015.50 100 a 
4: 2015.75 100 a 
5: 2016.00 100 a 
6: 2016.25  0 a 
7: 2015.00 100 b 
8: 2015.25 80 b 
9: 2015.50 60 b 
10: 2015.75 40 b 
11: 2016.00 20 b 
12: 2016.25  0 b 
13: 2015.00 100 c 
14: 2015.50 70 c 
15: 2016.00 40 c 
16: 2016.50 30 c 
17: 2017.00 20 c 
18: 2017.50  0 c 

Ainsi, chaque prêt dans cet exemple a une maturité de 5 ans et à la date d'échéance du prêt est entièrement amorti . Remarque: Les dates ne sont pas toujours incrémentées d'un semestre ou d'un trimestre, mais peuvent différer (voir les exemples de données).

Pour calculer le la WAL j'ai créé le suivant le code de R

Counter <- unique(DT$id) 

# LOOP OVER ID 
for (i in 1:length(Counter)) { 

# SUBSET ONE ID 
DTSub <- DT[id == Counter[i], ] 

# LOOP OVER THE AMORTIZATIONDATES 
CounterSub <- unique(DTSub$date) 

for (j in 1:length(CounterSub)) { 

# SUBSET RANGE OF DATES IN COUNTERSUB 
DTSub_Date <- DTSub[date >= CounterSub[j], ] 
DTSub_Date[, t := abs(min(date)-date)] 
DT[id == Counter[i] & date == CounterSub[j], 
     wal_calc := round(sum(abs(diff(DTSub_Date$value)) 
    /max(DTSub_Date$value) * DTSub_Date$t[2:nrow(DTSub_Date)]),3)] 

} 
} 

La sortie du code

DT 

     date value id wal_calc 
1: 2015.00 100 a 1.250 
2: 2015.25 100 a 1.000 
3: 2015.50 100 a 0.750 
4: 2015.75 100 a 0.500 
5: 2016.00 100 a 0.250 
6: 2016.25  0 a 0.000 
7: 2015.00 100 b 0.750 
8: 2015.25 80 b 0.625 
9: 2015.50 60 b 0.500 
10: 2015.75 40 b 0.375 
11: 2016.00 20 b 0.250 
12: 2016.25  0 b 0.000 
13: 2015.00 100 c 1.300 
14: 2015.50 70 c 1.143 
15: 2016.00 40 c 1.125 
16: 2016.50 30 c 0.833 
17: 2017.00 20 c 0.500 
18: 2017.50  0 c 0.000 

La sortie du code est correct (wal_calc) mais utilise une double boucle for, et est donc lente sur des jeux de données relativement volumineux (le mien a 77k lignes et 200 colonnes).

La première boucle for sous-classe les ID et les secondes sous-ensembles futures (par id, basé sur le premier sous-ensemble).

Demande

Je voudrais être en mesure de générer WALS sur ces données d'échantillons de manière de manière plus rapide et plus efficace et d'éviter cette double boucle. Il pourrait y avoir une solution très simple à ce problème.

Si quelque chose n'est pas clair s'il vous plaît faites le moi savoir.

Answer 1

Cela le fera sans for boucles.

DT[order(date), WAL := { 
    pmts <- matrix(value[-.N] - value[-1L], 
       nrow = n2 <- .N - 1L, ncol = n2) 
    ts <- matrix(date[-1L] - date[-.N], nrow = n2, ncol = n2) 
    ts[upper.tri(ts)] <- 0 
    ts <- apply(ts, 2, cumsum) 
    c(colSums(pmts * ts)/value[-.N], 0)}, by = id] 
DT 
    date value id  WAL 
# 1: 2015.00 100 a 1.2500000 
# 2: 2015.25 100 a 1.0000000 
# 3: 2015.50 100 a 0.7500000 
# 4: 2015.75 100 a 0.5000000 
# 5: 2016.00 100 a 0.2500000 
# 6: 2016.25  0 a 0.0000000 
# 7: 2015.00 100 b 0.7500000 
# 8: 2015.25 80 b 0.6250000 
# 9: 2015.50 60 b 0.5000000 
# 10: 2015.75 40 b 0.3750000 
# 11: 2016.00 20 b 0.2500000 
# 12: 2016.25  0 b 0.0000000 
# 13: 2015.00 100 c 1.3000000 
# 14: 2015.50 70 c 1.1428571 
# 15: 2016.00 40 c 1.1250000 
# 16: 2016.50 30 c 0.8333333 
# 17: 2017.00 20 c 0.5000000 
# 18: 2017.50  0 c 0.0000000 

Answer 2

vous pouvez utiliser apply à la place pour le premier sous-ensemble. Ensuite, vous auriez juste besoin d'une boucle.

ids <- unique(DT$id) 

DTSub <- apply(DT, 1, function(x) if x$id %in% ids) 

CounterSub <- unique(DTSub$date)