Skip to content
Snippets Groups Projects
Commit 8876e403 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer
Browse files

Docs work on Vignette: table formatting, tariff defs, section on contractGrid and on increases 

-) proper table formatting (kableExtra) in vignette
-) Provide sample tariffs for the most common types of insurance contracts
-) Write section on contractGrid
-) write section on (fixed and dynamic) increases
parent f841d044
Branches
Tags
No related merge requests found
Hide whitespace changes
Inline Side-by-side
vignettes/using-the-lifeinsurancecontracts-package.Rmd
+ 463
− 12
View file @ 8876e403
......@@ -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)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment