diff --git a/vignettes/using-the-lifeinsurancecontracts-package.Rmd b/vignettes/using-the-lifeinsurancecontracts-package.Rmd index 65ac3b738b27e4c5390e7cc01c2e9e6562db099b..03431d2783b6def869134dca60cd2d919d6e2609 100644 --- a/vignettes/using-the-lifeinsurancecontracts-package.Rmd +++ b/vignettes/using-the-lifeinsurancecontracts-package.Rmd @@ -20,7 +20,7 @@ vignette: > --- -```{r echo = FALSE, message=FALSE} +```{r setup, echo = FALSE, message=FALSE} knitr::opts_chunk$set(collapse = TRUE, comment = "#>") library(knitr) library(kableExtra) @@ -36,6 +36,15 @@ panderOptions('digits', 12) panderOptions('keep.trailing.zeros', TRUE) panderOptions('table.split.table', 120) +kableTable = function(grd, ...) { + grd %>% + kable(...) %>% + add_header_above(header = c(1, dim(grd)[[2]]) %>% `names<-`(names(dimnames(grd))), align = "c") %>% + kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), full_width = F) %>% + column_spec(1, bold = T, border_right = T) +} + + ## Modified pandoc.list function that also works with NULL entries in the lists: pandoc.listRK.return <- function(elements, style = c('bullet', 'ordered', 'roman'), loose = FALSE, add.line.breaks = TRUE, add.end.of.list = TRUE, indent.level = 0, missing = panderOptions('missing')) { #nolint @@ -115,10 +124,9 @@ pandoc.listRK <- function(...) cat(pandoc.listRK.return(...)) - - ``` + The LifeInsuranceContracts package provides a full-featured framework to model classical life insurance contracts (non-unit linked). Mathematically, a general life insurance contracts can be defined using death and survival (and disability) benefit vectors to define the cash flows and calculate all premiums and reserves recursively. This powerful approach is taken by the LifeInsuranceContracts package to provide the most flexible contract modelling framework in R. # General Overview of the Concepts @@ -371,8 +379,7 @@ grd = contractGridPremium( grd ``` ```{r SimpleExampleRiskPremiumGridOut, echo = F} -# TODO: Table with dimnames in vignette -grd %>% as.data.frame() %>% rownames_to_column("age | policyPeriod") %>% pander +grd %>% kableTable(digits = 2) ``` @@ -387,9 +394,11 @@ grd ``` ```{r SimpleExampleRiskPremiumGrid3DOut, echo=F, results="asis"} for (d in dimnames(grd)[[3]]) { - cat("* , , ", names(dimnames(grd))[[3]], "=", d, "\n", sep = "") - cat(grd[,,d ] %>% as.data.frame() %>% rownames_to_column("age \\| policyPeriod") %>% pander(digits = 7, round = 2, style = "rmarkdown")) + cat("\n", "* , , ", names(dimnames(grd))[[3]], "=", d, "\n\n", sep = "") + # cat(grd[,,d ] %>% as.data.frame() %>% rownames_to_column("age \\| policyPeriod") %>% pander(digits = 7, round = 2, style = "rmarkdown")) + cat(grd[,,d ] %>% kableTable(digits = 2), "\n") } + ``` @@ -546,6 +555,126 @@ Tarif.PureEnd.SP = Tarif.PureEnd$createModification( ) ``` +### Sample tariffs for the most common types of life insurance + +For the examples in the remainder of this vignette, we can create some more +example tariffs covering the most common types of life insurance. + + +**General definitions for all tariffs** +```{r TarifDefinitions.All} +library(MortalityTables) +mortalityTables.load("Austria_Census") +mortalityTables.load("Austria_Annuities_AVOe2005R") + # Costs: 4% acquisition, where 2.5% are zillmered, 5\% of each premium as beta costs, + # 1%o acquisition costs of the sum insured over the whole contract period +example.Costs = initializeCosts( + alpha = 0.04, Zillmer = 0.025, + beta = 0.05, + gamma.contract = 0.001, gamma.paidUp = 0.001 +) +example.Surrender = function(surrenderReserve, params, values) { + n = params$ContractData$policyPeriod + # Surrender Penalty is 10% at the beginning and decreases linearly to 0% + surrenderReserve * (0.9 + 0.1 * (0:n)/n) +} +``` + +**Endowment** + +```{r TarifDefinitions.All.End} +Tarif.Endowment = InsuranceTarif$new( + name = "Example Tariff - Endowment", + type = "endowment", + tarif = "EN1", + desc = "An endowment with regular premiums", + + mortalityTable = mort.AT.census.2011.unisex, + i = 0.005, + costs = example.Costs, + unitcosts = 10, + tax = 0.04, # 4% insurance tax + surrenderValueCalculation = example.Surrender +) +``` + +**Whole / Term Life Insurance** +```{r TarifDefinitions.All.Life} +Tarif.Life = InsuranceTarif$new( + name = "Example Tariff - Whole/Term Life", + type = "wholelife", + tarif = "Life1", + desc = "A whole or term life insurance with regular premiums", + + mortalityTable = mort.AT.census.2011.unisex, + i = 0.005, + costs = example.Costs, + unitcosts = 10, + tax = 0.04, # 4% insurance tax + surrenderValueCalculation = example.Surrender +) +``` + +**Immediate Annuity (single premium)** +```{r TarifDefinitions.All.ImmAnnuity} +Tarif.ImmAnnuity = InsuranceTarif$new( + name = "Example Tariff - Immediate Annuity", + type = "annuity", + tarif = "Ann1", + desc = "An annuity with single-premium", + premiumPeriod = 1, + + mortalityTable = AVOe2005R.unisex, + i = 0.005, + costs = example.Costs, + tax = 0.04 # 4% insurance tax +) +``` + +**Deferred Annuity** +```{r TarifDefinitions.All.DefAnnuity} +# Premium periods and deferral periods can also be given as a function of other +# contract parameters (like the age at contract inception, etc.) +Tarif.DefAnnuity = InsuranceTarif$new( + name = "Example Tariff - Deferred Annuity", + type = "annuity", + tarif = "Life1", + desc = "A deferred annuity (life-long payments start at age 65) with reg. premiums", + + contractPeriod = function(params, values) { 120 - params$ContractData$age}, + deferralPeriod = function(params, values) { 65 - params$ContractData$age}, + premiumPeriod = function(params, values) { 65 - params$ContractData$age}, + + mortalityTable = AVOe2005R.unisex, + i = 0.005, + costs = example.Costs, + tax = 0.04, # 4% insurance tax + surrenderValueCalculation = example.Surrender +) +``` + +**Dread-Disease Insurance** +```{r TarifDefinitions.All.DD} +# An example dread-disease tariff, morbidity is assumed linearly increasing with age +ddTable = mortalityTable.period(name = "Linear dread-disease table", + ages = 0:100, deathProbs = 0:100/500) +Tarif.DreadDisease = InsuranceTarif$new( + name = "Example Tariff - Dread-Disease", + type = "dread-disease", + tarif = "DD1", + desc = "A dread disease insurance with a lump-sum payment upon diagnosis", + + sumInsured = 50000, + mortalityTable = mort.AT.census.2011.unisex, + invalidityTable = ddTable, + i = 0.005, + costs = example.Costs, + unitcosts = 10, + tax = 0.04, # 4% insurance tax + surrenderValueCalculation = example.Surrender +) +``` + ## Creating a contract for a given tariff While the tariff describes the general product features, the contract object @@ -591,7 +720,7 @@ this: ```{r Contract} contract.PureEnd = InsuranceContract$new( Tarif.PureEnd, - age = 40, policyPeriod = 45, + age = 50, policyPeriod = 20, premiumFrequency = 12, sumInsured = 100000, contractClosing = as.Date("2020-07-01") @@ -612,7 +741,7 @@ collective). The premium refund can be overridden directly in the contract call: ```{r ContractNoRefund} contract.PureEnd.NoRefund = InsuranceContract$new( Tarif.PureEnd, - age = 40, policyPeriod = 45, + age = 50, policyPeriod = 20, premiumFrequency = 12, sumInsured = 100000, contractClosing = as.Date("2020-07-01"), @@ -878,8 +1007,72 @@ For this purpose, this package provides two functions to create two- or higher-dimensional grids of contracts with each dimension representing one of the parameters varying. -* `contra -TODO +* `contractGrid()` creates a (two- or higher-dimensional) grid of `InsuranceContract` object +* `contractGridPremium()` creates a grid of the premiums + +The grid is defined by the `axes` argument to the `contractGrid()` call. This is +a named list giving all parameters that should vary inside the grid. Any of the +parameters of the `InsuranceContract$new()` constructor can be used in the axes. + +For example, one can compare multiple tariffs or multiple varying pararameters. + +Let us look at the pure endowment above, which we implemented as a single-premium +variant and a variant with regular premiums, both of which have a potential +(partial or full) premium refund in case of death. How do the premiums of these +contracts compare and how do the premiums depend on the premium refund proportion? + +```{r Grid.Endowment.compare} +contractGridPremium( + axes = list(tarif = c(Tarif.PureEnd, Tarif.Endowment, Tarif.PureEnd.SP), premiumRefund = c(0, 0.5, 1)), + age = 50, policyPeriod = 20, + sumInsured = 10000, + contractClosing = as.Date("2020-09-01") +) +``` + +The default implementation of `contractGridPremium` returns the written premium, +but one can also choose other types of premiums to display, or even other +contract values (like reserves). + +If one needs to investigate multiple values, it is better to first create a grid +of insurance contract objects and store it, so that the call to `contractGridPremium` +does not have to re-calculate the same contracts over and over again, extract just +one premium and discard the whole contract. + +```{r Grid.Endowment.compareOther} +grd = contractGrid( + axes = list(tarif = c(Tarif.PureEnd, Tarif.Endowment, Tarif.PureEnd.SP), premiumRefund = c(0, 0.5, 1)), + age = 50, policyPeriod = 20, + sumInsured = 10000, + contractClosing = as.Date("2020-09-01") +) + +# Compare net premiums without loadings: +contractGridPremium(grd, premium = "net") + +# Compare premium sums over the whole contract period (all contracts have the same sumInsured) +contractGridPremium(grd, .fun = function(c) {c$Values$unitPremiumSum * c$Values$premiums["written"]}) + +# Compare risk premiums at time t=10 (the 11th row of the premium decomposition) +contractGridPremium(grd, .fun = function(c) {c$Values$premiumComposition[11, "risk"]}) + +# Compare present value of all benefits and refunds (without costs) at time t=0 +contractGridPremium(grd, .fun = function(c) {c$Values$absPresentValues[1, "benefitsAndRefund"]}) + +``` + + +Other usefil examples of grid comparisons include e.g. the effect of the interest +rate and the mortality table on the premiums: + +```{r Grid.Protection} +contractGridPremium( + axes = list(mortalityTable = mort.AT.census["m", ], i = c(0, 0.005, 0.01), age = c(30, 45, 60), policyPeriod = c(10, 20)), + tarif = Tarif.Life, + contractClosing = as.Date("2020-09-01"), + sumInsured = 10000 +) +``` # Exporting contract data to Excel @@ -971,7 +1164,265 @@ in the file names. # Handling contracts with increases (fixed increasing benefits / premiums, dynamic increases, sum increases) -TODO +While many insurance contracts have a fixed sum insured and constant premium, +many contracts include some kind of adjustment to account for inflation. There +are various ways to achieve such an adjustment: + +* The initial contract already includes a planned increase in the benefits by a + pre-determined factor $(1+s)$ each year, premiums are constant over the whole + duration. +* The initial contract has fixed sum insured, but the premiums increase by a + factor $(1+s)$ each year due to salary increases. +* "Dynamic increases": The initial contract has fixed sum insured with fixed + regular premiums. However, every year (or triggered based on an inflation or + consumer price index) the sum insured is increased by a certain amount (either + fixed or by the same percentage as the index) and the premiums are increased + accordingly. Internally, this is represented by a second, shorter contract + covering only the increase in sumInsured, from which the additional premium can + be calculated according to the tariff. + +The LifeInsuranceContract package provides functionality for each of these increases. +All three increases can in theory be combined in the same contract, although +in practice this usually does not happen and at most one kind of increase is +included in a contract + +## Fixed yearly premium increase with constant sum insured + +With this kind of increases, the initial contract valuation (i.e. the determination +of the premium at contract inception) already takes into account that the premium +will not stay constant over the whole period, +but increases by a constant factor each year. The sum insured is calculated by +the equivalence principle so that the expected present value of all future +benefits and costs equals the expected present value of all future (i.e. +increasing) premium payments. + +This type of yearly premium increase by a fixed factor can be implemented by +the parameter: + +* `premiumIncrease` ... The factor, by which the premium increases yearly. Default is 1.0 (no increase in premium). + +In the following example, we create a 20-year endowment contract with constant +premiums over the whole period and another one with idential parameters except +that the premium increases by 4\% each year: + +```{r PremiumIncrease.Endowment, results = "hide"} +# For comparison: Contract with constant premiums +contract.Endow.Constant = InsuranceContract$new( + tarif = Tarif.Endowment, + sumInsured = 10000, + age = 40, policyPeriod = 20, + contractClosing = as.Date("2020-09-01") +) +# Contract with 4% yearly premium increase and same sum insured +contract.Endow.PremInc = InsuranceContract$new( + tarif = Tarif.Endowment, + sumInsured = 10000, + premiumIncrease = 1.04, + age = 40, policyPeriod = 20, + contractClosing = as.Date("2020-09-01") +) +premium.comparison = data.frame( + `Sum Insured` = contract.Endow.Constant$Values$basicData[,"SumInsured"], + `Constant Premium` = contract.Endow.Constant$Values$basicData[,"Premiums"], + `4% Yearly Increase` = contract.Endow.PremInc$Values$basicData[,"Premiums"], + check.names = F + ) +``` +```{r PremiumIncrease.EndowmentOut, results = "asis"} +premium.comparison %>% pander +``` + + +## Fixed yearly benefit increase with constant premium + +With this kind of increases, the premium will stay constant over the whole +contract maturity, but the death and/or survival benefit (or the annuity payment) +will increase by a fixed factor each year. This is typically to safeguard the +benefit against inflation, so that the value of the annuity payment or death benefit +does not diminish due to inflation. The initial contract valuation (i.e. the determination +of the constant premium at contract inception) already takes into account that +the benefits will not stay constant over the whole period, +but increases by a constant factor each year. + +This type of yearly benefit increase by a fixed factor can be implemented by +the parameters: + +* `annuityIncrease` ... The factor, by which potential annuity payments increase yearly. Default is 1.0 (no increase in annuity benefits) +* `deathBenefit` ... The vector of death benefits (relative to the sum insured, which for endowments describes the survival benefit) + +In the following example, we create a 20-year endowment contract with constant +premiums over the whole period and another one with idential parameters except +that the premium increases by 4\% each year: + +```{r FixedSumIncrease.WholeLife, results = "hide"} +# For comparison: Contract with constant premiums +contract.TermLife.Constant = InsuranceContract$new( + tarif = Tarif.Life, + sumInsured = 10000, + age = 40, policyPeriod = 20, + contractClosing = as.Date("2020-09-01") +) +# Contract with 4% yearly increase in sum insured (final survival benefit is 10.000) +contract.TermLife.SumInc = InsuranceContract$new( + tarif = Tarif.Life, + sumInsured = 10000, + deathBenefit = (1.04)^(0:20), + age = 40, policyPeriod = 20, + contractClosing = as.Date("2020-09-01") +) +premium.comparison = data.frame( + `Const S.I.` = contract.TermLife.Constant$Values$absCashFlows[,"death"], + `Const. Premium` = contract.TermLife.Constant$Values$absCashFlows[,"premiums_advance"], + `4% sum increase` = contract.TermLife.SumInc$Values$absCashFlows[,"death"], + `Premium w. sum increase` = contract.TermLife.SumInc$Values$absCashFlows[,"premiums_advance"], + check.names = F + ) +``` +```{r FixedSumIncrease.WholeLifeOut, results = "asis"} +premium.comparison %>% pander +``` + +For annuities, the benefit increase is not handled through `deathBenefits`, but +rather through the parameter + +* `annuityIncrease` ... yearly increase factor of the annuity payments + +In the following example, we create a 20-year endowment contract with constant +premiums over the whole period and another one with idential parameters except +that the premium increases by 4\% each year: + +```{r FixedSumIncrease.Annuity, results = "hide"} +# For comparison: Contract with constant annuity +contract.Annuity.Constant = InsuranceContract$new( + tarif = Tarif.DefAnnuity, + sumInsured = 1200, + age = 50, + policyPeriod = 20, + deferralPeriod = 10, + premiumPeriod = 10, + contractClosing = as.Date("2020-09-01") +) +# Contract with 4% yearly increase in annuity benefits +contract.Annuity.Increasing = InsuranceContract$new( + tarif = Tarif.DefAnnuity, + sumInsured = 1200, + annuityIncrease = 1.04, + age = 50, + policyPeriod = 20, + deferralPeriod = 10, + premiumPeriod = 10, + contractClosing = as.Date("2020-09-01") +) +# Contract with 4% yearly increase in premiums and in annuity payments +contract.Annuity.IncreasingBoth = InsuranceContract$new( + tarif = Tarif.DefAnnuity, + sumInsured = 1200, + annuityIncrease = 1.04, + premiumIncrease = 1.04, + age = 50, + policyPeriod = 20, + deferralPeriod = 10, + premiumPeriod = 10, + contractClosing = as.Date("2020-09-01") +) +premium.comparison = data.frame( + `Const. Annuity` = contract.Annuity.Constant$Values$absCashFlows[,"survival_advance"], + `Const. Premium` = contract.Annuity.Constant$Values$absCashFlows[,"premiums_advance"], + `4% Annuity Increase` = contract.Annuity.Increasing$Values$absCashFlows[,"survival_advance"], + `Premium w. Ann.Increase` = contract.Annuity.Increasing$Values$absCashFlows[,"premiums_advance"], + `Inc.Premium w. Ann.Increase` = contract.Annuity.IncreasingBoth$Values$absCashFlows[,"premiums_advance"], + check.names = F + ) +``` +```{r FixedSumIncrease.AnnuityOut, results = "asis"} +premium.comparison %>% pander +``` + + + +## Dynamic Increases + +With dynamic increases, the contract initially is written with a fixed sum insured +and constant premiums over the whole contract period. The future increases are +not considered at all. + +After the initial contract inception, either yearly or when a consumer price +index changes by a value larger than a given threshold, the sum insured is +increased (either by a fixed amount or by an amount determined by the index change) +and the premium is adjusted accordingly. Internally, the original contract is +left untouched and the increase is modelled by a separate contract with the +same key parameters, only with shorter duration and a sum insured that represents +only the increase. The premium for this increase is calculated like a separate +contract with only the difference in the over-all sum insured as its sum insured. + +Each dynamic increase then adds another separate tiny InsuranceContract object +and the over-all values are the sums of all those contract blocks (sometimes +also called "contract slices"). + +The `InsuranceContract` class provides a method to add a dynamic increase: + +* `InsuranceContract$addDynamics(t, NewSumInsured, SumInsuredDelta, id, ...)` + +Only one of `NewSumInsured` (new total sum insured) and `SumInsuredDelta` (only +the difference between old and new sum insured) is needed. This method adds a +new contract block to the given InsuranceContract, starting at time $t$ with +`SumInsuredDelta` as its sum insured and its premium calculated from the +shorter contract period and the sum insured delta. These blocks for dynamic increases +are stored in the contract's `$blocks` list of children. The values stored in the +contract are then simply the sum of all its children. + +Here is an example of a 10-year endowment, which has dynamic increases at times $t=5$, $t=7$ and $t=8$: + + +```{r DynamicIncrease.Endowment} +# For comparison: Contract with constant annuity +contract.Endowment.Dynamics = InsuranceContract$new( + tarif = Tarif.Endowment, + sumInsured = 10000, + age = 40, + policyPeriod = 10, + contractClosing = as.Date("2020-09-01"), + id = "Initial contract" +)$ + addDynamics(t = 5, NewSumInsured = 11000, id = "Dynamic at 5")$ + addDynamics(t = 7, NewSumInsured = 12000, id = "Dynamic at 7")$ + addDynamics(t = 8, NewSumInsured = 13500, id = "Dynamic at 8") + +# Over-all contract sum insured and premiums for all blocks combined +contract.Endowment.Dynamics$Values$basicData[,c("SumInsured", "Premiums")] %>% pander +``` +```{r DynamicIncrease.EndowmentOut, results = "asis", echo = F} +blk = c(list(`Over-all contract` = contract.Endowment.Dynamics), contract.Endowment.Dynamics$blocks) + +padArray = function(arr = NULL, pad = 0, len = 0) { + padEnd = max(0, len - pad - NROW(arr)) # if len is too short, return an array containing at least the arr + nrcols = ifelse(is.null(arr), 0, NCOL(arr)) + rbind( + array(0, dim = c(pad, nrcols)) %>% `colnames<-`(colnames(arr)), + arr, + array(0, dim = c(padEnd, nrcols)) %>% `colnames<-`(colnames(arr)) + ) %>% `colnames<-`(colnames(arr)) +} + +lapply(blk, function(b) { + basic = padArray(b$Values$basicData, pad = b$Parameters$ContractData$blockStart) + basic[,"SumInsured"] +}) %>% + bind_cols() %>% + rowid_to_column("t") %>% + mutate(t = t-1) %>% + pander(caption = "Sum Insured for the over-all contract and each of the blocks") + +lapply(blk, function(b) { + basic = padArray(b$Values$basicData, pad = b$Parameters$ContractData$blockStart) + basic[,"Premiums"] +}) %>% + bind_cols() %>% + rowid_to_column("t") %>% + mutate(t = t-1) %>% + pander(caption = "Premium time series for the over-all contract and each of the blocks") + +``` # Advance profit participation (premium rebate)