setwd("~/Dropbox/UDLAP/Cursos/2022 Primavera/Pensiones y SS/Presentaciones")
ciencias<-read.csv("ciencias.csv")
Now, we define a benefit the following way:
This can be seen, then as a flat unit benefit…
First, we need to have a life table to support our estimations:
ILT<-read.csv("ILT1.csv")
library(lifecontingencies)
## Package: lifecontingencies
## Authors: Giorgio Alfredo Spedicato [aut, cre]
## (<https://orcid.org/0000-0002-0315-8888>),
## Christophe Dutang [ctb] (<https://orcid.org/0000-0001-6732-1501>),
## Reinhold Kainhofer [ctb] (<https://orcid.org/0000-0002-7895-1311>),
## Kevin J Owens [ctb],
## Ernesto Schirmacher [ctb],
## Gian Paolo Clemente [ctb] (<https://orcid.org/0000-0001-6795-4595>),
## Ivan Williams [ctb]
## Version: 1.3.6
## Date: 2019-03-05 23:50:03 UTC
## BugReport: http://github.com/spedygiorgio/lifecontingencies/issues
LT<-probs2lifetable(ILT$qx,radix=100000,type="qx")
We can estimate the accrual for the year:
ciencias$bx<-0.015*ciencias$Salary
summary(ciencias$Salary)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 645 9000 12900 15357 19000 80000
summary(ciencias$bx)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 9.675 135.000 193.500 230.353 285.000 1200.000
In order to estimate the Accrued benefits we have to estimate some elements:
Remember that this dataset is from 2021.Then:
ciencias$ar <- axn(LT,x=60,i=0.035,payment="due")
ciencias$ttr<- 60-ciencias$Age
ciencias$wy<- 2021-ciencias$StartYr
table(ciencias$wy)
##
## -7978 0 1 2 3 4 5 6 7 8 9 10 11
## 1 41 181 136 143 102 79 69 48 34 28 26 44
## 12 13 14 15 16 17 18 19 20 21 22 23 24
## 18 26 18 20 28 12 15 15 11 23 6 8 12
## 25 26 27 28 29 30 31 32 33 34 35 36 39
## 3 9 9 8 3 4 4 4 1 1 2 1 1
## 41 42 52
## 1 1 1
ciencias<-ciencias[which(ciencias$wy>0),]
ciencias$y<- ciencias$Age-ciencias$wy
table(ciencias$wy)
##
## 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
## 181 136 143 102 79 69 48 34 28 26 44 18 26 18 20 28 12 15 15 11
## 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 39 41 42 52
## 23 6 8 12 3 9 9 8 3 4 4 4 1 1 2 1 1 1 1 1
table(ciencias$y)
##
## 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31
## 1 2 1 1 1 7 8 12 26 52 91 109 112 80 85 77 48 52 49 34
## 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51
## 45 25 21 21 25 16 12 17 17 10 18 5 10 4 7 7 8 3 6 4
## 52 53 54 57 58 59 60 61 62 64 66 69 71
## 4 3 2 6 1 2 2 1 1 1 1 1 1
table(ciencias$Age)
##
## 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46
## 3 11 30 49 70 62 45 53 50 44 54 47 47 62 34 26 30 24 26 39 18 24 29 21 25 17
## 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72
## 17 18 19 16 10 8 20 15 10 14 6 8 8 13 4 1 5 5 4 3 2 1 1 1 1 1
## 73 76 79
## 2 1 1
ciencias<-ciencias[which(ciencias$Age<60),]
Now, we can estimate the accrued benefit, remember that the formula is:
\[ b_x \times (x-y) \]
ciencias$Bx<-ciencias$bx*(ciencias$Age-ciencias$y)
summary(ciencias$Bx)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 22.5 360.0 900.0 1859.2 2250.0 30450.0
And now the actuarial liability: \[ B_x \cdot {_{r-x}p_x} \cdot v^{r-x} \cdot \ddot{a_r } \]
ciencias$AL<-ciencias$Bx*pxt(LT,x=ciencias$Age,t=ciencias$ttr)*(1.035^{-ciencias$ttr})*ciencias$ar
summary(ciencias$AL)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 76.5 1584.4 4221.1 13278.0 13612.9 363604.2
And the normal cost \[ b_x \cdot {_{r-x}p_x} \cdot v^{r-x} \cdot \ddot{a_r } \]
ciencias$NC<-ciencias$bx*pxt(LT,x=ciencias$Age,t=ciencias$ttr)*
(1.035^{-ciencias$ttr})*ciencias$ar
summary(ciencias$NC)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 30.62 591.08 948.27 1334.11 1664.47 12538.07
Now, we can use the constant dollar modification,
\[ ^{CD}b_x=\frac{B_r}{r-y} \] \[ ^{CD}B_x=\frac{B_r}{r-y} \times (x-y) \]
for this… we have to determine the final salary. Assume salary increases at a rate of 4% per year. Therefore, we have to estimate the salary at age 59 and the benefit ar retirement
ciencias$sr<-ciencias$Salary*(1.04^(59-ciencias$Age))
ciencias$Br<-0.015*ciencias$sr*(60-ciencias$y)
summary(ciencias$Br)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 569.4 10218.1 16231.9 19355.2 24954.9 129897.0
Now, we estimate the accrual at age \(x\) and the accrued benefit.
ciencias$cdbx<- ciencias$Br/(60-ciencias$y)
ciencias$cdBx<- ciencias$cdbx*(ciencias$Age-ciencias$y)
summary(ciencias$Bx)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 22.5 360.0 900.0 1859.2 2250.0 30450.0
And now, we define the actuarial liability by the benefit prorate method:
\[ AL_x=\frac{x-y}{r-y}B_r \cdot {_{r-x}p_x} \cdot v^{r-x} \cdot \ddot{a_r } \]
We just have to realize that:
\[ ^{CD}B_x=\frac{B_r}{r-y} \times (x-y) \]
Then:
\[ AL_x={^{CD}B_x} \cdot {_{r-x}p_x} \cdot v^{r-x} \cdot \ddot{a_r } \]
ciencias$BDAL<- ciencias$cdBx*pxt(LT,x=ciencias$Age,t=ciencias$ttr)*
(1.035^{-ciencias$ttr})*ciencias$ar
summary(ciencias$BDAL)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 301.7 4792.1 11424.7 23899.7 29083.5 393274.3
And normal cost under this metho is:
ciencias$BDNC<- ciencias$cdbx*pxt(LT,x=ciencias$Age,t=ciencias$ttr)*
(1.035^{-ciencias$ttr})*ciencias$ar
summary(ciencias$BDNC)
## Min. 1st Qu. Median Mean 3rd Qu. Max.
## 130.7 1778.3 2467.2 2988.3 3729.4 15173.2
And now, we estimate the aggregate liability and normal cost:
AL1<-sum(ciencias$AL)
NC1<-sum(ciencias$NC)
AL2<- sum(ciencias$BDAL)
NC2<- sum(ciencias$BDNC)
AL1
## [1] 14725298
AL2
## [1] 26504795
NC1
## [1] 1479525
NC2
## [1] 3314055