1.1 The Dataset

link = "https://master.dl.sourceforge.net/project/dataset-quan/hmd_life_table.csv?viasf=1"
countries = read.csv(link)

# Overview
glimpse(countries)

## Rows: 820,290
## Columns: 8
## $ year    <int> 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 1921, 19…
## $ age     <int> 0, 1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12, 13, 14, 15, 16, 17, …
## $ qx      <dbl> 0.05750, 0.01199, 0.00576, 0.00288, 0.00325, 0.00251, 0.00248,…
## $ lx      <dbl> 100000, 94250, 93120, 92583, 92316, 92016, 91785, 91557, 91391…
## $ dx      <int> 5750, 1130, 537, 267, 300, 231, 228, 166, 126, 125, 114, 105, …
## $ gender  <chr> "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F", "F…
## $ country <chr> "AUS", "AUS", "AUS", "AUS", "AUS", "AUS", "AUS", "AUS", "AUS",…
## $ px      <dbl> 0.94250, 0.98801, 0.99424, 0.99712, 0.99675, 0.99749, 0.99752,…

sample = countries %>% filter(country == 'FIN', year == '1999')
sample_F = sample %>% filter(gender == 'F')
sample_M = sample %>% filter(gender == 'M')

1.2 Pure Endowment

Problem 1. Cynthia is now 20 years old. She has been offered 2 options:

1. She will be surely received 10,000 EUR at the age 25.
2. She will receive 10,000 EUR if she is still alive at age 25.

How much should she pay now for each option, assume the constant interest rate is 2%?

# Option 1
PV = 10000 * (1 + 0.02) ^ (-5)
PV

## [1] 9057.308

# Option 2
kpx = prod((sample_F %>% filter(age %in% (20:24)))$px)
PV * kpx

## [1] 9041.74

What happens to the present value of the pure endowment when changing the time horizon from 5 to 10 or 30 years?

PV = 10000 * (1 + 0.02) ^ - c(5, 10, 30)
kpx = cumprod((sample_F %>% filter(age %in% (20:50)))$px)
PV * kpx[c(5, 10, 30)]

## [1] 9041.740 8175.388 5375.319

The present value of the pure endowment decreases significantly as the awarded time increases.

Problem 2. A man aged 65 will receive the following cashflows if he is still alive in the following years, as illustrated by the below figure.

Compute the present value of the benefits.

benefits = c(500, 400, 300, rep(200, 5))
discount_factors = (1 + 0.03) ^ - (0:7)
kpx = c(1, cumprod((sample_M %>% filter(age %in% (65:71)))$px))
sum(benefits * discount_factors * kpx)

## [1] 1913.29

1.3 Guaranteed Payments

Problem 3. Mr. Incredible is 35 years old. He won a special prize: a life annuity of 10,000 EUR each year for life! The first payment starts at the end of the first year. Moreover, the first 10 payments are guaranteed. Assume the constant interest rate is 3%. What is the value of his prize?

kpx = c(1, cumprod((sample_M %>% filter(age %in% (35:109)))$px))
discount_factors = (1 + 0.03) ^ - (0:(length(kpx) - 1))
benefits_guaranteed = c(0, rep(10^4, 10), rep(0, length(kpx) - 11))
benefits_nonguaranteed = c(rep(0, 11), rep(10^4, length(kpx) - 11))
sum(benefits_guaranteed * discount_factors) + 
  sum(benefits_nonguaranteed * discount_factors * kpx)

## [1] 223372.4

1.4 Retirement Plan

Problem 4. Mrs. Incredible is 35 years old. She wants to buy a life annuity that provides 12,000 EUR annually for life, beginning at age 65. She will finance this product with annual premiums, payable for 30 years beginning at age 35. Premiums reduce by one-half after 15 years. Assume the constant interest rate is 3%, what is her initial premium?

kpx = c(1, cumprod((sample_F %>% filter(age %in% (35:110)))$px))
discount_factors = (1 + 0.03) ^ - (0:(length(kpx) - 1))
benefits = c(rep(0, 30), rep(12000, length(kpx) - 30))
rho = c(rep(1, 15), rep(0.5, 15), rep(0, length(kpx) - 30))
sum(benefits * discount_factors * kpx) / sum(rho * discount_factors * kpx)

## [1] 4162.862

1.5 Deferred Mortality Rates

kpx = c(1, cumprod((sample_F %>% filter(age %in% (18:109)))$px))
kqx = kpx * (sample_F %>% filter(age %in% (18:110)))$qx
plot(0:(length(kqx) - 1), kqx, col = "blue", type = "l", pch = 20,
     xlab = "Year From 18th Birthday",
     ylab = "Mortality Rates",
     main = "Deferred Mortality Rates of 18-Year-Old Female, Finland 1999")

1.6 Simple Life Insurance

Problem 5. Consider a very simple life insurance product: a product sold to a customer aged 20 that pays 10,000 EUR at the end of the year of death if death occurs at a given age 30. This insurance protects the customer in the bad event that he/she dies at age 30. Assume the constant interest rate is 1%, what is the expected present value of this simple life insurance?

kpx = prod((sample_F %>% filter(age %in% (20:29)))$px)
kqx = kpx * (sample_F %>% filter(age == 30))$qx
discount_factor = (1 + 0.01) ^ (-11)
10000 * discount_factor * kqx

## [1] 2.679762

1.7 Whole Life Insurance

Problem 6. A man aged 20. He buy a whole life insurance that gives 10,000 EUR if he dies at any age in the future. Assume the constant interest rate is 3%, compute the expected present value of this product.

p_benefits = cumprod(c(1, (sample_M %>% filter(age %in% (20:109)))$px)) * 
  (sample_M %>% filter(age %in% (20:110)))$qx
benefits = c(rep(10000, 110 - 20 + 1))
discount = (1 + 0.03) ^ - (1:91)
benefits_discount = benefits * discount
sum(p_benefits * benefits_discount)

## [1] 2182.367

We provide a R function for calculating expected present value of a whole life insurance, with specified parameters.

whole_life_insurance = function(age, i, life_table, annual_benefits) {
  qx = life_table$qx 
  px = 1 - qx
  kpx = c(1, cumprod(px[(age + 1):(length(px) - 1)]))
  kqx = kpx * qx[(age + 1):length(qx)]
  discount_factors = (1 + i) ^ - (1:length(kqx))
  benefits = c(rep(annual_benefits, length(kqx)))
  sum(discount_factors * benefits * kqx)
}

whole_life_insurance(age = 20, i = 0.03, life_table = sample_M,
                     annual_benefits = 10000)

## [1] 2182.367

1.8 Temporary Life Insurance

Problem 7. A man aged 20. He buys a temporary life insurance that gives 10,000 EUR if he dies at any age in the next 50 years. Assume the constant interest rate is 3%, compute the expected present value of this product.

p_benefits = cumprod(c(1, (sample_M %>% filter(age %in% (20:69)))$px)) * 
  (sample_M %>% filter(age %in% (20:70)))$qx
benefits = c(rep(10000, 70 - 20 + 1))
discount = (1 + 0.03) ^ - (1:51)
benefits_discount = benefits * discount
sum(p_benefits * benefits_discount)

## [1] 1109.662

We provide a R function for calculating expected present value of a temporary life insurance, with specified parameters.

temporary_life_insurance = function(age, i, life_table, annual_benefits, n) {
  qx = life_table$qx
  px = 1 - qx
  kpx = c(1, cumprod(px[(age + 1):(age + n)]))
  kqx = kpx * qx[(age + 1):(age + n + 1)]
  discount_factors = (1 + i) ^ - (1:(n + 1))
  benefits= c(rep(annual_benefits, (n + 1)))
  sum(discount_factors * benefits * kqx)
}

temporary_life_insurance(age = 20, i = 0.03, life_table = sample_M,
                         annual_benefits = 10000, n = 50)

## [1] 1109.662

Problem 8. Miss Cathleen, aged 48, seeks for financial protection in case she would die around her retirement. To protect her growing-up children she wants to insure a benefit of 40,000 EUR for death between age 55 and 75. Assume the constant interest rate is 5%, compute the expected present value of this product.

# Solution 1
prod((sample_F %>% filter(age %in% (48:54)))$px) * (1 + 0.05) ^ (-7) *
  temporary_life_insurance(age = 55, i = 0.05, life_table = sample_F,
                           annual_benefits = 40000, n = 20)

## [1] 2917.405

# Solution 2
p_benefits = cumprod(c(1,(sample_F %>% filter(age %in% (48:74)))$px)) * 
  (sample_F %>% filter(age %in% (48:75)))$qx
benefits = c(rep(0, 7), rep(40000, 75 - 55 + 1))
discount = (1 + 0.05) ^ - (1:28)
benefits_discount = benefits * discount
sum(p_benefits * benefits_discount)

## [1] 2917.405

1.9 Deferred Life Insurance

Problem 9. A man aged 20. He buys a deferred life insurance that gives 10,000 EUR if he dies at any age after the next 30 years. Assume the constant interest rate is 3%, compute the expected present value of this product.

p_benefits = cumprod(c(1, (sample_M %>% filter(age %in% (20:109)))$px)) * 
  (sample_M %>% filter(age %in% (20:110)))$qx
benefits = c(rep(0, 30), rep(10000, 110 - 50 + 1))
discount = (1 + 0.03) ^ - (1:91)
benefits_discount = benefits * discount
sum(p_benefits * benefits_discount)

## [1] 1802.194

We provide a R function for calculating expected present value of a deferred life insurance, with specified parameters.

deferred_life_insurance = function(age, i, life_table, annual_benefits, n) {
  qx = life_table$qx
  px = 1 - qx
  kpx = c(1, cumprod(px[(age + 1):(length(px) - 1)]))
  kqx = kpx * qx[(age + 1):length(qx)]
  discount_factors = (1 + i) ^ - (1:length(kqx))
  benefits = c(rep(0, n), rep(annual_benefits, length(kqx) - n))
  sum(discount_factors * benefits * kqx)
}

deferred_life_insurance(age = 20, i = 0.03, life_table = sample_M,
                        annual_benefits = 10000, n = 30)

## [1] 1802.194

2.1 Initial Assumptions

Assume that the chance a person aged \(n-1\) years survives pass his/her \(n^{\textrm{th}}\) year of life is \((100-0.5n)\%,\) then the chance a newborn baby survives the next \(n\) years is \[\begin{align*}P_n=\prod_{i=0}^n(100-0.5i)\% &= \frac{199}{200}\cdot\frac{198}{200}\cdot...\cdot\frac{200-n}{200}\\ &= \frac{199!}{200^n\cdot(199-n)!},\forall n=\overline{1,199},\end{align*}\] with \(P_0=1,P_{200}=0.\)

2.2 Modified Assumptions

We now assume that:

1. Any person survives surely until his/her \(50^{\textrm{th}}\) birthday;
2. The chance a person aged \(49+n\) years survives pass his/her \((50+n)^{\textrm{th}}\) year of life is \((100-2n)\%.\)

Following the same procedure, we can prove that the chance a newborn baby survives the next \(n\) years is now \[P'_n=\frac{49!}{50^{n-50}\cdot(99-n)!},\forall n=\overline{50,99}\] with \(P'_{100}=0\) and \(P'_i=1,\forall i=\overline{0,49}.\)