R Markdown

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