Import packages

library(readxl)
library(dplyr)
library(ggplot2)
library(psych)

Import data set and mortality Table (TD-88-90)

setwd("C:/Users/user/Desktop")
data = read_excel("Data_5.xlsx")
Table = read_excel("Table_T.xlsx")

attach(data)
attach(Table)

Assumptions

accural_rate = 1/30

intrest_rate = 0.15

i_before = 0.14

i_after = 0.12

\[\nu_a=\frac {1}{1+i}\]

nu_a = 1/(1+intrest_rate)

\[i^*=\frac{1+i}{1+j}-1=\frac{i-j}{1+j}\]

i_c = (intrest_rate-i_after)/(1+i_after)

\[\nu_c=\frac{1}{1+i^*}\]

nu_c = 1/(1+i_c)

\[d_c=\frac{i^*}{1+i^*}\]

d_c = i_c/(1+i_c)

Calculate \(p_x\) , \(q_x\) and \(A_x\)

\[p_x=\frac{L_{x+1}}{L_x}\] \[q_x=1-p_x\] \[A_x = \nu.q_x+\nu. p_x .A_{x+1}\space\space\space and \space\space\space \nu=\nu_c\]

Table = mutate(.data = Table, p_x = Lx[R+1]/Lx[R])

Table = mutate(.data = Table, q_x = 1-p_x )

attach(Table)
A = function(x){
  if (x == 106) {
    return(nu_c)
  }
  else  
    return((nu_c*q_x[x+1])+(nu_c*p_x[x+1]*A(x+1)))
}
Table = data.frame(Table , A_x)

head(Table)
##   R Age     Lx       p_x          q_x       A_x
## 1 1   0 100000 0.9912900 0.0087100000 0.1657459
## 2 2   1  99129 0.9992737 0.0007263263 0.1628943
## 3 3   2  99057 0.9995255 0.0004744743 0.1666523
## 4 4   3  99010 0.9996667 0.0003332997 0.1707227
## 5 5   4  98977 0.9997070 0.0002929974 0.1750207
## 6 6   5  98948 0.9997271 0.0002728706 0.1794683
View(Table)

calculations

data = mutate(.data = data , gender = if_else(condition = gender==0 , "Female" , "Male"))

data = mutate(.data = data , age_p = age - Service_year)

data = mutate(.data = data , retirement_age1 = if_else(gender=="Female", 55 , 60))

data = mutate(.data = data , retirement_age2 = age_p+35)

data = mutate(.data = data , retirement_age = if_else(retirement_age1<retirement_age2 , retirement_age1,retirement_age2))

data = mutate(.data = data , diff = retirement_age - age)

data = mutate(.data = data , diff_p_age = (Lx[retirement_age+1]/Lx[age+1]))

data = mutate(.data = data , nu = nu_a^diff)


data = mutate(.data = data , ad = (1-A_x[retirement_age+1])/d_c )

head(data)
## # A tibble: 6 x 13
##   Personal_ID gender   age Service_year Salary age_p retirement_age1
##         <dbl> <chr>  <dbl>        <dbl>  <dbl> <dbl>           <dbl>
## 1           1 Male      40           21 5.62e7    19              60
## 2           2 Male      40           20 5.70e7    20              60
## 3           3 Male      40           20 5.92e7    20              60
## 4           4 Female    41           19 4.10e7    22              55
## 5           5 Female    39           20 5.91e7    19              55
## 6           6 Female    46           20 4.30e7    26              55
## # ... with 6 more variables: retirement_age2 <dbl>, retirement_age <dbl>,
## #   diff <dbl>, diff_p_age <dbl>, nu <dbl>, ad <dbl>
View(data)
head(data)
## # A tibble: 6 x 13
##   Personal_ID gender   age Service_year Salary age_p retirement_age1
##         <dbl> <chr>  <dbl>        <dbl>  <dbl> <dbl>           <dbl>
## 1           1 Male      40           21 5.62e7    19              60
## 2           2 Male      40           20 5.70e7    20              60
## 3           3 Male      40           20 5.92e7    20              60
## 4           4 Female    41           19 4.10e7    22              55
## 5           5 Female    39           20 5.91e7    19              55
## 6           6 Female    46           20 4.30e7    26              55
## # ... with 6 more variables: retirement_age2 <dbl>, retirement_age <dbl>,
## #   diff <dbl>, diff_p_age <dbl>, nu <dbl>, ad <dbl>
ggplot(data = data , mapping = aes(x = gender , y = ..count../sum(..count..)) ) + geom_bar(fill = c("pink" , "royal blue") ) + labs(x = "gender", y = "percentage")

n = ggplot(data = data , aes(x = age)) + geom_dotplot(aes(fill = ..x..))
n + scale_fill_gradientn(colours = rainbow(10))
## `stat_bindot()` using `bins = 30`. Pick better value with `binwidth`.

  data %>%
  group_by(gender) %>%
  summarize(n = n(),
         mean = round(mean(Salary),0),
         min = min(Salary),
         max = max(Salary)
         )
## `summarise()` ungrouping output (override with `.groups` argument)
## # A tibble: 2 x 5
##   gender     n     mean      min      max
##   <chr>  <int>    <dbl>    <dbl>    <dbl>
## 1 Female    15 46158194 36127350 59122680
## 2 Male      85 52263492 36568680 69865140
ggplot(data = data , aes(x = gender, y = Salary)) +geom_violin(fill = "cornflowerblue") + geom_boxplot(width = .2,  fill = "orange", outlier.color = "orange", outlier.size = 2) + labs(title = "Salary distribution by gender")

  data %>%
  group_by(gender) %>%
  summarize(n = n(),
         mean = round(mean(age_p),0),
         min = min(age_p),
         max = max(age_p)
         )
## # A tibble: 2 x 5
##   gender     n  mean   min   max
##   <chr>  <int> <dbl> <dbl> <dbl>
## 1 Female    15    21    15    26
## 2 Male      85    20    14    29
ggplot(data, 
       aes(x = gender, 
           y = age_p, 
           color = gender)) +
  geom_boxplot(size=1,
               outlier.shape = 1,
               outlier.color = "black",) +
  geom_jitter()+
  theme_minimal() +
  theme(legend.position = "none") +
  coord_flip()

  data %>%
  group_by(gender) %>%
  summarize(n = n(),
         mean = round(mean(age),0),
         min = min(age),
         max = max(age)
         )
## # A tibble: 2 x 5
##   gender     n  mean   min   max
##   <chr>  <int> <dbl> <dbl> <dbl>
## 1 Female    15    41    38    46
## 2 Male      85    43    36    53
ggplot(data, 
       aes(x = gender, 
           y = age, 
           color = gender)) +
  geom_boxplot(size=1,
               outlier.shape = 1,
               outlier.color = "black",) +
  geom_jitter()+
  theme_minimal() +
  theme(legend.position = "none") +
  coord_flip()

  data %>%
  group_by(gender) %>%
  summarize(n = n(),
         mean = round(mean(diff),0),
         min = min(diff),
         max = max(diff)
         )
## # A tibble: 2 x 5
##   gender     n  mean   min   max
##   <chr>  <int> <dbl> <dbl> <dbl>
## 1 Female    15    13     9    15
## 2 Male      85    12     5    17
ggplot(data, 
       aes(x = gender, 
           y = diff, 
           color = gender)) +
  geom_boxplot(size=1,
               outlier.shape = 1,
               outlier.color = "black",) +
  geom_jitter()+
  theme_minimal() +
  theme(legend.position = "none") +
  coord_flip()

  data %>%
  group_by(gender) %>%
  summarize(n = n(),
         mean = round(mean(retirement_age),0),
         min = min(retirement_age),
         max = max(retirement_age)
         )
## # A tibble: 2 x 5
##   gender     n  mean   min   max
##   <chr>  <int> <dbl> <dbl> <dbl>
## 1 Female    15    54    50    55
## 2 Male      85    55    49    60
ggplot(data, 
       aes(x = gender, 
           y = retirement_age, 
           color = gender)) +
  geom_boxplot(size=1,
               outlier.shape = 1,
               outlier.color = "black",) +
  geom_jitter()+
  theme_minimal() +
  theme(legend.position = "none") +
  coord_flip()

PUC calculations

\[S_{Fin}=Salary . \frac{s_{retirement\space age -1}}{s_{age-1}}\]

data_puc = mutate(.data = data , S_fin = Salary*((1+i_before)^diff))

actuarial liability - PUC

\[_0^\space V=\alpha\space.service\space year \space .S_{Fin}\space.\nu_a^{retirement\space age -age}._{retiremnt\space age - age}p_{age}\space.\ddot a_{\space retirment\space age}\] \[\ddot a_{retirement\space age}=\frac{1-A_{retirement\space age}}{d_c}\]

data_puc = mutate(.data = data_puc , v_puc = accural_rate*Service_year*S_fin*diff_p_age*nu*ad)

\[C=\frac{_0^\space V}{Service\space year} \] Normal Costs - PUC

data_puc = mutate(.data = data_puc , C_puc = v_puc/Service_year)

data_puc = mutate(.data = data_puc , p_puc = C_puc/Salary)
head(data_puc)
## # A tibble: 6 x 17
##   Personal_ID gender   age Service_year Salary age_p retirement_age1
##         <dbl> <chr>  <dbl>        <dbl>  <dbl> <dbl>           <dbl>
## 1           1 Male      40           21 5.62e7    19              60
## 2           2 Male      40           20 5.70e7    20              60
## 3           3 Male      40           20 5.92e7    20              60
## 4           4 Female    41           19 4.10e7    22              55
## 5           5 Female    39           20 5.91e7    19              55
## 6           6 Female    46           20 4.30e7    26              55
## # ... with 10 more variables: retirement_age2 <dbl>, retirement_age <dbl>,
## #   diff <dbl>, diff_p_age <dbl>, nu <dbl>, ad <dbl>, S_fin <dbl>, v_puc <dbl>,
## #   C_puc <dbl>, p_puc <dbl>
View(data_puc)
  data_puc %>%
  summarize(
         mean = mean(v_puc),
         min = min(v_puc),
         max = max(v_puc)
         )
## # A tibble: 1 x 3
##         mean        min        max
##        <dbl>      <dbl>      <dbl>
## 1 547208385. 308019336. 983267892.
  data_puc %>%
  summarize(
         mean = mean(C_puc),
         min = min(C_puc),
         max = max(C_puc)
         )
## # A tibble: 1 x 3
##        mean       min       max
##       <dbl>     <dbl>     <dbl>
## 1 23896252. 15221672. 36417329.
  data_puc %>%
  summarize(
         mean = mean(p_puc),
         min = min(p_puc),
         max = max(p_puc)
         )
## # A tibble: 1 x 3
##    mean   min   max
##   <dbl> <dbl> <dbl>
## 1 0.467 0.367 0.582

actuarial liability - TUC

\[_0^\space V=\alpha\space.salary \space .service \space year\space \space.\nu_a^{retirement\space age -age}.\space_{retiremnt\space age - age}\space p\space_{age}\space.\ddot a_{\space retirment\space age}\]

data_tuc = mutate(.data = data , v_tuc = accural_rate*Salary*Service_year*diff_p_age*nu*ad)

\[C=\space _0^\space V \space.\space (\frac{service\space year+1 }{service \space year}\space . \space \frac{S_{age+1}}{s_{age}}-1)\] Normal Costs - TUC

data_tuc = mutate(.data = data_tuc , C_tuc = v_tuc*((((Service_year+1)/Service_year)*(((1+i_before)*Salary)/Salary))-1))

data_tuc = mutate(.data = data_tuc , p_tuc = C_tuc/Salary)

head(data_tuc)
## # A tibble: 6 x 16
##   Personal_ID gender   age Service_year Salary age_p retirement_age1
##         <dbl> <chr>  <dbl>        <dbl>  <dbl> <dbl>           <dbl>
## 1           1 Male      40           21 5.62e7    19              60
## 2           2 Male      40           20 5.70e7    20              60
## 3           3 Male      40           20 5.92e7    20              60
## 4           4 Female    41           19 4.10e7    22              55
## 5           5 Female    39           20 5.91e7    19              55
## 6           6 Female    46           20 4.30e7    26              55
## # ... with 9 more variables: retirement_age2 <dbl>, retirement_age <dbl>,
## #   diff <dbl>, diff_p_age <dbl>, nu <dbl>, ad <dbl>, v_tuc <dbl>, C_tuc <dbl>,
## #   p_tuc <dbl>
View(data_tuc)
  data_tuc %>%
  summarize(
         mean = mean(v_tuc),
         min = min(v_tuc),
         max = max(v_tuc)
         )
## # A tibble: 1 x 3
##         mean       min        max
##        <dbl>     <dbl>      <dbl>
## 1 132773679. 33204390. 505688761.
  data_tuc %>%
  summarize(
         mean = mean(C_tuc),
         min = min(C_tuc),
         max = max(C_tuc)
         )
## # A tibble: 1 x 3
##        mean      min       max
##       <dbl>    <dbl>     <dbl>
## 1 24870877. 6751559. 90012599.
  data_tuc %>%
  summarize(
         mean = mean(p_tuc),
         min = min(p_tuc),
         max = max(p_tuc)
         )
## # A tibble: 1 x 3
##    mean   min   max
##   <dbl> <dbl> <dbl>
## 1 0.491 0.145  1.58
sum(data_puc$v_puc)
## [1] 54720838548
sum(data_puc$C_puc)
## [1] 2389625193
sum(data_tuc$v_tuc)
## [1] 13277367890
sum(data_tuc$C_tuc)
## [1] 2487087744