In merlinoa/diehard3000: Simulate Survival Contingent Benefits using Actuarial Life Tables

We provide life insurance.

How much money do we need in reserve to cover the life insurance benefit for all of our policies?

library(diehard3000)
library(knitr) # for tables

options(scipen=999) # turn off scientific notation

Create Example Policies

policies <- data.frame(id = c("A001", "A002", "A003", "A004", "A005", "A006"),
                       gender = c("male", "female", "female", "male", "male", "female"),
                       age = c(40, 51, 70, 45, 65, 35),
                       death_benefit = c(200000, 500000, 100000, 500000, 1000000, 2000000))

# format and print table
out <- policies
out$death_benefit <- format(out$death_benefit, big.mark = ",")
knitr::kable(out, align = c("l", "l", "r", "r"))

Each row in the above table represents a policy for a single individual. If all of these individuals die this very second our liability will be r format(sum(policies$death_benefit), big.mark = ","). The probability of these r nrow(policies) people dying instantaneously is low, and since we can invest and grow our money over time we don't need to keep r format(sum(policies$death_benefit), big.mark = ",") in reserve to have a high probability of having sufficient reserves to fullfill our liabilities. The diehard3000 package can simulate the time until death for the individuals and thus come up with probabilities for how much money (calculated at present value) we (as the insurer) need in reserves.

Back to the policies: As you can see, we have male and female individuals of varying ages. They also have varying death benefits.

We are going to create an object of class diehard3000::Life to represent each one of these individuals. The future probability of death for each of these individuals is defined by an actuarial life table. The diehard3000 package can use any life table you want, but here we are using the official 2010 US social security life table as provided on the Official Social Security Website.

Before the life tables can be used we need to define them as LifeTable objects:

# create male life table from qx_data (provided with the package)
qx_male <- diehard3000::LifeTable(x = c(qx_data$x, max(qx_data$x) + 1), 
                              q_x = c(qx_data$male_qx, NA)
                              )

# create female life table from qx_data (provided with the package)
qx_female <- diehard3000::LifeTable(x = c(qx_data$x, max(qx_data$x) + 1),
                                q_x = c(qx_data$female_qx, NA)
                                )

Now that we have male and female life tables lets assign each individual to a diehard3000::Life object. The Life object identifies the gender, age, and other policy characteristics appropriate to the individul policy. Once the Life object is defined we can run the simulations.

# I am finding the max age of the life tables so I can 
# make examples inwhich the Insuree's life insurance policy 
# lasts until the end of the life table.
max_m <- max(qx_male@x)
max_f <- max(qx_female@x)

# define each policy as an Insuree object
hold <- list()
for (j in 1:nrow(policies)) {
  hold[[j]] <- if (policies$gender[j] == "male") {
    diehard3000::Life(x_ = policies$age[j], 
                     t_ = max_m - policies$age[j],
                     benefit = list(BenefitDeath(t = max_m - policies$age[j],
                                                 value = policies$death_benefit[j])),
                     life_table = qx_male)
  } else {
    diehard3000::Life(x_ = policies$age[j],
                     t_ = max_f - policies$age[j],
                     benefit = list(BenefitDeath(t = max_f - policies$age[j],
                                                 value = policies$death_benefit[j])), 
                     life_table = qx_female)
  }
}

Each element in our hold list is an object of class Life.

Simulate a Single Policy

We can simulate the future life and present value of the benefits for any of these Life objects individually like so:

First we need to decide how many simulations we want to run and our discount rate.

# select number of times to simulate the individual's future life
n <- 10000

# set discount rate
interest <- Interest(t = 100, rate = 0.04)

now for the simulation:

set.seed(12345)
quants <- c(seq(0.70, 0.95, by = 0.05), 0.99, 0.999, 0.9999)
# simulate individual Insuree
single <- rpv(hold[[1]], n = n, interest = interest)
total <- single$pv
quantiles <- quantile(total, quants)
sim_mean <- mean(total)

# make it look decent for printing
out <- data.frame("Risk Level" = c("mean", names(quantiles)),
                 "Value" = format(round(c(sim_mean, quantiles), 0), big.mark = ","))
knitr::kable(out, row.names = FALSE, align = c("l", "r"))

The above table shows our simulations of the first row/policy in our table of policies. The "Value" column in the above table shows our risk/confidence level for the present value of the death benefit payment. The above table should appear reasonable for a r policies$age[1] year old American r policies$gender[1] with a r format(policies$death_benefit[1], big.mark = ",") life insurance policy.

The package also comes with some built in plot options for rpv() on class Life.

plot(single)
hist(single)

Simulate Multiple Policies

Simulating one life insurance policy is not that interesting. The real power of the diehard3000 package comes when we group the policies together. By simulating the group we can come up with confidence levels for the present value of future benefit payments that would be very difficult to calculate from first principles.

We run r format(n, big.mark = ",") observations of each individual's future life expectancy. We assume each individual future life expectancy is independent. We discount the death benefit, assuming a r interest@rate[1] * 100% annual interest rate.

# create object of class "Pool"
pool <- Pool(lives = hold)
# run simulation on each insuree
# we are only interested in the present value of the simulation here
pooled_rpv <- diehard3000::rpv(pool, n = n, interest = interest)
total <- apply(summary(pooled_rpv), 1, sum)
quantiles <- quantile(total, c(seq(0.70, 0.95, by = 0.05), 0.99, 0.999, 0.9999))
sim_mean <- mean(total)

# make it look decent for printing
out <- data.frame("Risk Level" = c("mean", names(quantiles)),
                 "Value" = format(c(sim_mean, quantiles), big.mark = ","))
knitr::kable(out, row.names = FALSE, align = c("l", "r"))

We can make also make plots for the pooled policies:

plot(pooled_rpv)
hist(pooled_rpv)

As expected the 99.9% confidence level for the pooled policies is significantly less than the sum of the undiscounted death benefits. By selling multiple independent policies we have diversified our risk.

merlinoa/diehard3000 documentation built on May 22, 2019, 6:52 p.m.