LAT4072_5

R Markdown

Social security and pensions

setwd("C:/Users/23043/Dropbox/UDLAP/Cursos/2022 Primavera/Pensiones y SS/Datos")
base<-read.csv("datos1.csv")
head(base)

##   ID Age Gender Weeks Salary Marital AgeSp Ch1 Ch2 Ch3 Par1 Par2   DisP
## 1  1  64      1  2269 332.27       1    62  -1  -1  -1   -1   -1 0.8898
## 2  2  53      1  1712 412.30       0     0  -1  -1  -1   -1   77 0.0973
## 3  3  44      2  1256 445.63       1    45  13   7   2   -1   -1 0.6794
## 4  4  52      1  1661 418.37       1    51  -1  -1  -1   -1   -1 0.6640
## 5  5  34      2   757 410.52       0     0  17  13   9   -1   -1 0.6986
## 6  6  54      1  1762 406.46       1    54  -1  -1  -1   77   -1 1.0000

We can start estimating the basic benefit for disability and survival. The first step is to obtain the pensionable salary:

\[ SP^{inv}=\frac{1}{d} \sum_{k=0}^d Sal \times \frac{365}{12} \quad d=min(t,10) \]

Since we don’t have the historic salary we will assume the salary has remained constant. Then:

base$sp<- base$Salary*365/12
summary(base$sp)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    5330   10107   11798   11251   13180   13576

Now, we can estimate the basic benefit:

\[ CB^{inv}=0.35\times SP^{inv} \]

base$cb<- 0.35*base$sp
summary(base$cb)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##    1865    3537    4129    3938    4613    4752

Now, we can estimate the pension benefit as:

\[ CP^{inv}= MAX[CB^{inv}\times (1+AF+AA),PG] \times 13 \]

So we need the value of the Pensión Garantizada, which is estimated for a 60 year old person with a minimum salary which was $2,622 in 2021. We also need the values for AF or AA.

base$pg<- 2622

base$AF<-0
base$AF<-ifelse(base$AgeSp>0,0.1,base$AF)
base$AF<-ifelse(base$Ch1>0,base$AF+0.1,base$AF)
base$AF<-ifelse(base$Ch2>0,base$AF+0.1,base$AF)
base$AF<-ifelse(base$Ch3>0,base$AF+0.1,base$AF)
base$AF<-ifelse(base$Par1>0 & base$AF==0,base$AF+0.1,base$AF) 
base$AF<-ifelse(base$Par2>0 & base$Ch1<0 &
                base$AgeSp==0,base$AF+0.1,base$AF) 

base$AA<-0
base$AA<-ifelse(base$AF==0,0.2,0)

Now, we can estimate the pension:

base$cp<-base$cb*(1+base$AF+base$AA)
base$cp<-13*(ifelse(base$cb*(1+base$AF+base$AA)<base$pg,base$pg,base$cp))

summary(base$cp)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   34086   55468   63564   64681   77693   86482

Now, we need to use annuities to correctly estimate the benefits

We upload the file TMInv.csv which displays the information we need and we create a life table

mort<-read.csv("TMInv.csv")
head(mort)

##   Edad     Inv    ActH    ActM
## 1   15 0.03127 0.00091 0.00041
## 2   16 0.03127 0.00093 0.00041
## 3   17 0.03127 0.00096 0.00041
## 4   18 0.03127 0.00098 0.00041
## 5   19 0.03127 0.00101 0.00041
## 6   20 0.03127 0.00104 0.00042

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.7
## Date:     2021-03-21 22:00:02 UTC
## BugReport: https://github.com/spedygiorgio/lifecontingencies/issues

lt<-probs2lifetable(mort$Inv,radix = 1000000,type="qx",name = "Life Table")

Now, we can estimate our first Monto Constitutivo, using the formula provided:

base$ax<-axn(lt,x=base$Age,i=0.03)
base$MC<- ifelse(base$Age<60,base$cp*base$ax*1.02,base$cp*base$ax*1.02*1.11)
summary(base$MC)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  523427  714662  948222  936677 1148586 1306414

However, we know we can imprive this estimation by using the things we learned last semester, we have to be careful with the notation.

base$n<-ifelse(base$Age<60,60-base$Age,0)
base$ax_c<-ifelse(base$Age<60,axn(lt,x=base$Age,n=base$n,
                                  i=0.03)*pxt(lt,x=base$Age,t=base$n)*(1.03^(-base$n)),0)
base$MC2<-base$cp*1.02*(base$ax+0.11*base$ax_c)

summary(base$MC2)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  471555  720803  960314  947144 1181470 1337174

Pension for the spouse. In the same file where we found the probabilities of death for persons with disability, we find two additional columns: ActH and ActM. These are probabilities of death for men and women who are active (in terms of disability free)

ltM<-probs2lifetable(mort$ActH,radix=100000,type="qx",name = "Life Table Males")
ltF<-probs2lifetable(mort$ActM,radix=100000,type="qx",name = "Life Table Female")

temp<-base[,c("ID","Gender","Age","AgeSp")]
temp$aj<-0
temp<-as.matrix(temp)
for(i in 1:500){
  temp[i,5]<-ifelse(temp[i,2]==1,axyzn(tablesList = list(lt,ltF),x=c(temp[i,3],temp[i,4]),
                                       i=0.03,status="joint",payment="due"),
                    axyzn(tablesList = list(lt,ltM),x=c(temp[i,3],temp[i,4]),
                                  i=0.03,status="joint",payment="due"))
}
aj<-temp[,5]
base<-cbind(base,aj)
remove(temp)
base$aj<-ifelse(base$AgeSp==0,0,base$aj)
summary(base$aj)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.000   0.000   6.364  13.400  16.095

Now, we estimate the reversionary annuity:

base$ax_y<-ifelse(base$Gender==1,axn(ltF,x=base$AgeSp,i=0.03,payment = "due")-base$aj,
                  axn(ltM,x=base$AgeSp,i=0.03,payment = "due")-base$aj)
base$ax_y<-ifelse(base$AgeSp==0,0,base$ax_y)
summary(base$ax_y)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.000   0.000   3.812   7.509  12.363

Now, the monto constitutivo for the spouse is:

base$MCy<-0.8*base$cp*1.02*base$ax_y
summary(base$MCy)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##       0       0       0  202209  435640  653256

Now, we can repeat this for parents, we leave children to the end since we have to make some adjustments

For the father(Par1)

temp<-base[,c("ID","Gender","Age","Par1")]
temp$as1<-0
temp<-as.matrix(temp)
for(i in 1:500){
  temp[i,5]<-ifelse(temp[i,4]<0,0,axn(ltM,x=temp[i,4],i=0.03,payment="due")-axyzn(tablesList = list(lt,ltM),x=c(temp[i,3],temp[i,4]),
                                       i=0.03,status="joint",payment="due"))
}
as1<-temp[,5]
base<-cbind(base,as1)
remove(temp)

And for the mother

temp<-base[,c("ID","Gender","Age","Par2")]
temp$as2<-0
temp<-as.matrix(temp)
for(i in 1:500){
  temp[i,5]<-ifelse(temp[i,4]<0,0,axn(ltF,x=temp[i,4],i=0.03,payment="due")-axyzn(tablesList = list(lt,ltF),x=c(temp[i,3],temp[i,4]),
                                                                                  i=0.03,status="joint",payment="due"))
}
as2<-temp[,5]
base<-cbind(base,as2)
remove(temp)

summary(base$as1)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.4725  0.0000  6.9200

summary(base$as2)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.0000  0.5983  0.0000  8.4196

Now, with children. This is only valid for children under the age of 18 and while they are at school. For this, we need information on rates for leaving school…

We have that information in the table TDE

tde<-read.csv("TDE.csv")
TDE<-probs2lifetable(tde$deser,radix=100000,type="qx",name="School drop")
summary(TDE)

## This is lifetable:  School drop 
##  Omega age is:  26 
##  Expected curtated lifetime at birth is:  18.41145

For now, we can assume there is no mortality for children before age 26. (we will discuss this later)

temp<-base[,c("ID","Gender","Age","Ch1")]
temp$az1<-0
temp<-as.matrix(temp)
for(i in 1:500){
  temp[i,5]<-ifelse(temp[i,4]<0,0,axn(TDE,x=temp[i,4],i=0.03,payment="due")-axyzn(tablesList = list(lt,TDE),x=c(temp[i,3],temp[i,4]),
                                                                                  i=0.03,status="joint",payment="due"))
}
az1<-temp[,5]
base<-cbind(base,az1)
remove(temp)

temp<-base[,c("ID","Gender","Age","Ch2")]
temp$az2<-0
temp<-as.matrix(temp)
for(i in 1:500){
  temp[i,5]<-ifelse(temp[i,4]<0,0,axn(TDE,x=temp[i,4],i=0.03,payment="due")-axyzn(tablesList = list(lt,TDE),x=c(temp[i,3],temp[i,4]),
                                                                                  i=0.03,status="joint",payment="due"))
}
az2<-temp[,5]
base<-cbind(base,az2)
remove(temp)

temp<-base[,c("ID","Gender","Age","Ch3")]
temp$az3<-0
temp<-as.matrix(temp)
for(i in 1:500){
  temp[i,5]<-ifelse(temp[i,4]<0,0,axn(TDE,x=temp[i,4],i=0.03,payment="due")-axyzn(tablesList = list(lt,TDE),x=c(temp[i,3],temp[i,4]),
                                                                                  i=0.03,status="joint",payment="due"))
}
az3<-temp[,5]
base<-cbind(base,az3)
remove(temp)

summary(base$az1)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  0.0000  0.0000  0.6634  0.9420  1.6420  3.3411

summary(base$az2)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.000   1.628   1.462   2.638   3.341

summary(base$az3)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##   0.000   0.000   1.401   1.377   2.806   3.341

We can now estimate the benefits for children and parents, remember, parents only and only if there are no other members in the household.

base$MCz1<-0.2*base$cp*1.02*base$az1
base$MCz2<-0.2*base$cp*1.02*base$az2
base$MCz3<-0.2*base$cp*1.02*base$az3

base$MCs1<-ifelse(base$MCy+base$MCz1+base$MCz2+base$MCz3==0,0.2*base$cp*1.02*base$as1,0)
base$MCs2<-ifelse(base$MCy+base$MCz1+base$MCz2+base$MCz3==0,0.2*base$cp*1.02*base$as2,0)

And we can estimate the actuarial present value:

base$MCT<-base$MC2+base$MCy+base$MCz1+base$MCz2+base$MCz3+base$MCs1+base$MCs2
summary(base$MCT)

##    Min. 1st Qu.  Median    Mean 3rd Qu.    Max. 
##  472216  876136 1155749 1201896 1520568 2128321