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

Implement premium waiver. In the contract class, when the premiums are waived,... 

Implement premium waiver. In the contract class, when the premiums are waived, all future cash flows and derived preent values from that time on are recalculated. The premium-free sum insured is already known, as that is one column from the original reserves table.

Added flags to indicate that no further surrender penalty should be applied. Flag for alpha-cost refund has been added, but is no used yet.

In the premium waiver case, the premium cashflows from t onwards are set to 0, the gamma costs are set to gamma_nopremiums and no surrender penalty is applied any more. Apart from that, the present value and reserve calculation is exactly the same as in the original contract.
parent ad177af0
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
R/InsuranceContract.R
+ 102
− 77
View file @ 3e8b96a0
library(R6) library(R6)
library(openxlsx); library(openxlsx);
# require(xlsx)
InsuranceContract = R6Class( InsuranceContract = R6Class("InsuranceContract",
"InsuranceContract",
public = list( public = list(
tarif = NA, tarif = NA,
#### Contract settings #### Contract settings
params = list( params = list(
sumInsured = 1, sumInsured = 1,
premiumWaiver= 0, premiumWaiver = 0,
YOB = NA, YOB = NA,
age = NA, age = NA,
policyPeriod = Inf, policyPeriod = Inf,
...@@ -24,11 +23,14 @@ InsuranceContract = R6Class( ...@@ -24,11 +23,14 @@ InsuranceContract = R6Class(
premiumFrequency = 1, premiumFrequency = 1,
benefitFrequency = 1, # Only for annuities! benefitFrequency = 1, # Only for annuities!
loadings = list() # Allow overriding the tariff-defined loadings (see the InsuranceTariff class for all possible names) loadings = list(), # Allow overriding the tariff-defined loadings (see the InsuranceTariff class for all possible names)
surrenderPenalty = TRUE, # Set to FALSE after the surrender penalty has been applied once, e.g. on a premium waiver
alphaRefunded = FALSE # Alpha costs not yet refunded (in case of contract changes)
), ),
#### Caching values for this contract, initialized/calculated when the object is created #### Caching values for this contract, initialized/calculated when the object is created
values = list( values = list(
basicData = NA,
transitionProbabilities = NA, transitionProbabilities = NA,
cashFlowsBasic = NA, cashFlowsBasic = NA,
...@@ -50,18 +52,15 @@ InsuranceContract = R6Class( ...@@ -50,18 +52,15 @@ InsuranceContract = R6Class(
), ),
#### Keeping the history of all contract changes during its lifetime #### Keeping the history of all contract changes during its lifetime
history = list( history = list(),
),
#### The code: #### The code:
initialize = function(tarif, age, policyPeriod, initialize = function(tarif, age, sumInsured = 1,
premiumPeriod = policyPeriod, sumInsured = 1, policyPeriod, premiumPeriod = policyPeriod, guaranteed = 0,
..., ...,
loadings = list(), loadings = list(),
guaranteed = 0,
premiumPayments = "in advance", benefitPayments = "in advance", premiumPayments = "in advance", benefitPayments = "in advance",
premiumFrequency = 1, benefitFrequency = 1, premiumFrequency = 1, benefitFrequency = 1,
deferral = 0, YOB = 1975) { deferral = 0, YOB = 1975) {
...@@ -83,102 +82,128 @@ InsuranceContract = R6Class( ...@@ -83,102 +82,128 @@ InsuranceContract = R6Class(
if (!missing(guaranteed)) self$params$guaranteed = guaranteed; if (!missing(guaranteed)) self$params$guaranteed = guaranteed;
if (!missing(loadings)) self$params$loadings = loadings; if (!missing(loadings)) self$params$loadings = loadings;
self$recalculate(); self$calculateContract();
}, },
addHistorySnapshot = function(time=0, comment="Initial contract values", type="Contract", params=self$params, values = self$values) { addHistorySnapshot = function(time=0, comment="Initial contract values", type="Contract", params=self$params, values = self$values) {
self$history = c(self$history, self$history = rbind(self$history,
list("time"=time, "comment"=comment, "type"=type, "params"=params, "values"=values)); list(time=list("time"=time, "comment"=comment, "type"=type, "params"=params, "values"=values)));
}, },
recalculate = function() { calculateContract = function() {
self$determineTransitionProbabilities(); self$values$transitionProbabilities = self$determineTransitionProbabilities();
self$determineCashFlows();
self$calculatePresentValues();
self$calculatePremiums();
self$updatePresentValues(); # Update the cash flows and present values with the values of the premium
self$calculateAbsCashFlows();
self$calculateAbsPresentValues();
self$calculateReserves();
self$premiumAnalysis();
self$addHistorySnapshot(0, "Initial contract values", type="Contract", params=self$params, values = self$values);
},
determineTransitionProbabilities = function() {
self$values$transitionProbabilities = do.call(self$tarif$getTransitionProbabilities, self$params);
self$values$transitionProbabilities
},
determineCashFlows = function() { self$values$cashFlowsBasic = self$determineCashFlowsBasic();
self$values$cashFlowsBasic = do.call(self$tarif$getBasicCashFlows, self$params); self$values$cashFlows = self$determineCashFlows();
self$values$cashFlows = do.call(self$tarif$getCashFlows, c(self$params, self$values)); self$values$premiumSum = self$determinePremiumSum();
self$values$premiumSum = sum(self$values$cashFlows$premiums_advance + self$values$cashFlows$premiums_arrears); self$values$cashFlowsCosts = self$determineCashFlowsCosts();
self$values$cashFlowsCosts = do.call(self$tarif$getCashFlowsCosts, c(self$params, self$values));
list("benefits"= self$values$cashFlows, "costs"=self$values$cashFlowCosts, "premiumSum" = self$values$premiumSum)
},
calculatePresentValues = function() { self$values$presentValues = self$calculatePresentValues();
str(self$values); self$values$presentValuesCosts = self$calculatePresentValuesCosts();
self$values$presentValues = do.call(self$tarif$presentValueCashFlows,
c(self$params, self$values));
self$values$presentValuesCosts = do.call(self$tarif$presentValueCashFlowsCosts,
c(self$params, self$values));
list("benefits" = self$values$presentValues, "costs" = self$values$presentValuesCosts)
},
calculatePremiums = function() {
# the premiumCalculation function returns the premiums AND the cofficients, # the premiumCalculation function returns the premiums AND the cofficients,
# so we have to extract the coefficients and store them in a separate variable # so we have to extract the coefficients and store them in a separate variable
res = do.call(self$tarif$premiumCalculation, c(self$params, self$values)); res = self$calculatePremiums();
self$values$premiumCoefficients = res[["coefficients"]]; self$values$premiumCoefficients = res[["coefficients"]];
self$values$premiums = res[["premiums"]] self$values$premiums = res[["premiums"]]
self$values$premiums
},
updatePresentValues = function() { # Update the cash flows and present values with the values of the premium
pvAllBenefits = do.call(self$tarif$presentValueBenefits, c(self$params, self$values)); pvAllBenefits = self$calculatePresentValuesBenefits()
self$values$presentValues = cbind(self$values$presentValues, pvAllBenefits) self$values$presentValues = cbind(self$values$presentValues, pvAllBenefits)
self$values$presentValue
},
calculateAbsCashFlows = function() { self$values$absCashFlows = self$calculateAbsCashFlows();
self$values$absCashFlows = do.call(self$tarif$getAbsCashFlows, c(self$params, self$values)); self$values$absPresentValues = self$calculateAbsPresentValues();
self$values$absCashFlows self$values$reserves = self$calculateReserves();
}, self$values$basicData = self$getBasicDataTimeseries()
self$values$premiumComposition = self$premiumAnalysis();
calculateAbsPresentValues = function() { self$addHistorySnapshot(0, "Initial contract values", type="Contract", params=self$params, values = self$values);
self$values$absPresentValues = do.call(self$tarif$getAbsPresentValues, c(self$params, self$values));
self$values$absPresentValues
}, },
calculateReserves = function() { determineTransitionProbabilities = function(contractModification=NULL) {
self$values$reserves = do.call(self$tarif$reserveCalculation, c(self$params, self$values)); do.call(self$tarif$getTransitionProbabilities, c(self$params, self$values, list(contractModification=contractModification)));
self$values$reserves
}, },
determineCashFlowsBasic = function(contractModification=NULL) {
premiumAnalysis = function() { do.call(self$tarif$getBasicCashFlows, self$params);
self$values$premiumComposition = do.call(self$tarif$premiumDecomposition, c(self$params, self$values)); },
self$values$premiumComposition determineCashFlows = function(contractModification=NULL) {
do.call(self$tarif$getCashFlows, c(self$params, self$values, list(contractModification=contractModification)));
},
determinePremiumSum = function(contractModification=NULL) {
sum(self$values$cashFlows$premiums_advance + self$values$cashFlows$premiums_arrears);
},
determineCashFlowsCosts = function(contractModification=NULL) {
do.call(self$tarif$getCashFlowsCosts, c(self$params, self$values, list(contractModification=contractModification)));
},
calculatePresentValues = function(contractModification=NULL) {
do.call(self$tarif$presentValueCashFlows, c(self$params, self$values, list(contractModification=contractModification)));
},
calculatePresentValuesCosts = function(contractModification=NULL) {
do.call(self$tarif$presentValueCashFlowsCosts, c(self$params, self$values, list(contractModification=contractModification)));
},
calculatePremiums = function(contractModification=NULL) {
do.call(self$tarif$premiumCalculation, c(self$params, self$values, list(contractModification=contractModification)));
},
calculatePresentValuesBenefits = function(contractModification=NULL) {
do.call(self$tarif$presentValueBenefits, c(self$params, self$values, list(contractModification=contractModification)));
},
calculateAbsCashFlows = function(contractModification=NULL) {
do.call(self$tarif$getAbsCashFlows, c(self$params, self$values, list(contractModification=contractModification)));
},
calculateAbsPresentValues = function(contractModification=NULL) {
do.call(self$tarif$getAbsPresentValues, c(self$params, self$values, list(contractModification=contractModification)));
},
calculateReserves = function(contractModification=NULL) {
do.call(self$tarif$reserveCalculation, c(self$params, self$values, list(contractModification=contractModification)));
},
premiumAnalysis = function(contractModification=NULL) {
do.call(self$tarif$premiumDecomposition, c(self$params, self$values, list(contractModification=contractModification)));
},
getBasicDataTimeseries = function(contractModification=NULL) {
do.call(self$tarif$getBasicDataTimeseries, c(self$params, self$values, list(contractModification=contractModification)));
}, },
# Premium Waiver: Stop all premium payments at time t # Premium Waiver: Stop all premium payments at time t
# the SumInsured is determined from the available # the SumInsured is determined from the available
premiumWaiver = function (t) { premiumWaiver = function (t) {
newSumInsured = self$values$reserves[[toString(t), "PremiumFreeSumInsured"]]; newSumInsured = self$values$reserves[[toString(t), "PremiumFreeSumInsured"]];
self$premiumWaiver = TRUE; self$params$premiumWaiver = TRUE;
self$recalculatePremiumFreeSumInsured(t=t, SumInsured=newSumInsured) self$params$surrenderPenalty = FALSE; # Surrencer penalty has already been applied, don't apply a second time
self$params$alphaRefunded = TRUE; # Alpha cost (if applicable) have already been refunded partially, don't refund again
self$params$sumInsured = newSumInsured;
self$values$cashFlowsBasic = mergeValues(starting=self$values$cashFlowsBasic, ending=self$determineCashFlowsBasic(t), t=t);
self$values$cashFlows = mergeValues(starting=self$values$cashFlows, ending=self$determineCashFlows(t), t=t);
# Premium sum is not affected by premium waivers, i.e. everything depending on the premium sum uses the original premium sum!
# self$values$premiumSum = self$determinePremiumSum();
self$values$cashFlowsCosts = mergeValues3D(starting=self$values$cashFlowsCosts, ending=self$determineCashFlowsCosts(t), t=t);
pv = self$calculatePresentValues(t);
pvc = self$calculatePresentValuesCosts(t);
self$values$presentValuesCosts = mergeValues3D(starting=self$values$presentValuesCosts, ending=pvc, t=t);
# TODO: Update cashflows from t onwards # TODO:
# TODO: Update present values from t onwards # the premiumCalculation function returns the premiums AND the cofficients,
# TODO: Update reserves from t onwards # so we have to extract the coefficients and store them in a separate variable
# res = self$calculatePremiums(t);
# self$values$premiumCoefficients = mergeValues(starting=self$values$premiumCoefficients, ending=res[["coefficients"]], t=t);
# self$values$premiums = mergeValues(starting= = res[["premiums"]]
# Update the cash flows and present values with the values of the premium
pvAllBenefits = self$calculatePresentValuesBenefits()
self$values$presentValues = mergeValues(starting=self$values$presentValues, ending=cbind(pv, pvAllBenefits), t=t);
self$addHistorySnapshot(t=t, comment=sprintf("Premium waiver at time %d", t), type="PremiumWaiver", params=self$params, values=self$values); self$values$absCashFlows = mergeValues(starting=self$values$absCashFlows, ending=self$calculateAbsCashFlows(t), t=t);
self$values$absPresentValues = mergeValues(starting=self$values$absPresentValues, ending=self$calculateAbsPresentValues(t), t=t);
self$values$reserves = mergeValues(starting=self$values$reserves, ending=self$calculateReserves(t), t=t);
self$values$basicData = mergeValues(starting=self$values$basicData, ending=self$getBasicDataTimeseries(t), t=t);
self$values$premiumComposition = mergeValues(starting=self$values$premiumComposition, ending=self$premiumAnalysis(t), t=t);
self$addHistorySnapshot(time=t, comment=sprintf("Premium waiver at time %d", t), type="PremiumWaiver", params=self$params, values=self$values);
}, },
dummy=NULL dummy=NULL
) )
); );
# InsuranceContract$debug("premiumWaiver")
R/InsuranceTarif.R
+ 27
− 21
View file @ 3e8b96a0
library(R6) library(R6)
library(lifecontingencies) # library(lifecontingencies)
library(objectProperties) library(objectProperties)
library(foreach)
TariffTypeEnum = setSingleEnum("TariffType", levels = c("annuity", "wholelife", "endowment", "pureendowment", "terme-fix", "dread-disease")) TariffTypeEnum = setSingleEnum("TariffType", levels = c("annuity", "wholelife", "endowment", "pureendowment", "terme-fix", "dread-disease"))
PaymentTimeEnum = setSingleEnum("PaymentTime", levels = c("in advance", "in arrears")) PaymentTimeEnum = setSingleEnum("PaymentTime", levels = c("in advance", "in arrears"))
...@@ -128,7 +127,7 @@ InsuranceTarif = R6Class( ...@@ -128,7 +127,7 @@ InsuranceTarif = R6Class(
}, },
getBasicCashFlows = function(age, ..., guaranteed = 0, policyPeriod = inf, deferral = 0, maxAge = getOmega(self$mortalityTable)) { getBasicCashFlows = function(age, ..., guaranteed = 0, policyPeriod = inf, deferral = 0, maxAge = getOmega(self$mortalityTable)) {
maxlen = min(maxAge - age, policyPeriod); maxlen = min(maxAge - age, policyPeriod);
cf = list( cf = data.frame(
guaranteed = rep(0, maxlen+1), guaranteed = rep(0, maxlen+1),
survival = rep(0, maxlen+1), survival = rep(0, maxlen+1),
death = rep(0, maxlen+1), death = rep(0, maxlen+1),
...@@ -153,7 +152,7 @@ InsuranceTarif = R6Class( ...@@ -153,7 +152,7 @@ InsuranceTarif = R6Class(
cf cf
}, },
getCashFlows = function(age, ..., premiumPayments = "in advance", benefitPayments = "in advance", guaranteed = 0, policyPeriod=Inf, premiumPeriod = policyPeriod, deferral=0, maxAge = getOmega(self$mortalityTable), cashFlowsBasic = NULL) { getCashFlows = function(age, ..., premiumPayments = "in advance", benefitPayments = "in advance", guaranteed = 0, policyPeriod=Inf, premiumPeriod = policyPeriod, deferral=0, maxAge = getOmega(self$mortalityTable), cashFlowsBasic = NULL, premiumWaiver = FALSE) {
if (missing(cashFlowsBasic)) { if (missing(cashFlowsBasic)) {
cashFlowsBasic = self$getBasicCashFlows(age = age, ..., guaranteed = guaranteed, cashFlowsBasic = self$getBasicCashFlows(age = age, ..., guaranteed = guaranteed,
policyPeriod = policyPeriod, deferral = deferral, maxAge = maxAge); policyPeriod = policyPeriod, deferral = deferral, maxAge = maxAge);
...@@ -177,11 +176,13 @@ InsuranceTarif = R6Class( ...@@ -177,11 +176,13 @@ InsuranceTarif = R6Class(
); );
# Premiums: # Premiums:
premiums = pad0(rep(1, min(premiumPeriod, policyPeriod)), cflen); if (!premiumWaiver) {
if (premiumPayments == "in advance") { premiums = pad0(rep(1, min(premiumPeriod, policyPeriod)), cflen);
cf$premiums_advance = premiums; if (premiumPayments == "in advance") {
} else { cf$premiums_advance = premiums;
cf$premiums_arrears = premiums; } else {
cf$premiums_arrears = premiums;
}
} }
# Survival Benefits # Survival Benefits
...@@ -210,7 +211,7 @@ InsuranceTarif = R6Class( ...@@ -210,7 +211,7 @@ InsuranceTarif = R6Class(
cf cf
}, },
getCashFlowsCosts = function(age, ..., policyPeriod=Inf, premiumPeriod = policyPeriod, maxAge = getOmega(self$mortalityTable)) { getCashFlowsCosts = function(age, ..., policyPeriod=Inf, premiumPeriod = policyPeriod, premiumWaiver = FALSE, maxAge = getOmega(self$mortalityTable)) {
maxlen = min(maxAge - age, policyPeriod)+1; maxlen = min(maxAge - age, policyPeriod)+1;
policyPeriod = min(maxAge - age, policyPeriod); policyPeriod = min(maxAge - age, policyPeriod);
premiumPeriod = min(policyPeriod, premiumPeriod); premiumPeriod = min(policyPeriod, premiumPeriod);
...@@ -230,6 +231,11 @@ InsuranceTarif = R6Class( ...@@ -230,6 +231,11 @@ InsuranceTarif = R6Class(
for (i in 1:policyPeriod) { for (i in 1:policyPeriod) {
cf[i,,] = cf[i,,] + self$costs[,,"PolicyPeriod"]; cf[i,,] = cf[i,,] + self$costs[,,"PolicyPeriod"];
} }
# After premiums are waived, use the gamma_nopremiums instead of gamma:
if (premiumWaiver) {
cf[,"gamma",] = cf[,"gamma_nopremiums",];
}
cf cf
}, },
...@@ -245,8 +251,6 @@ InsuranceTarif = R6Class( ...@@ -245,8 +251,6 @@ InsuranceTarif = R6Class(
pvRefund = calculatePVDeath (px, qx, cashFlows$death_GrossPremium, v=self$v); pvRefund = calculatePVDeath (px, qx, cashFlows$death_GrossPremium, v=self$v);
pvRefundPast = calculatePVDeath (px, qx, cashFlows$death_Refund_past, v=self$v) * (cashFlows[,"death_GrossPremium"]-cashFlows[,"premiums_advance"]); pvRefundPast = calculatePVDeath (px, qx, cashFlows$death_Refund_past, v=self$v) * (cashFlows[,"death_GrossPremium"]-cashFlows[,"premiums_advance"]);
str(px/px);
str(qx*0);
pv = cbind( pv = cbind(
premiums = calculatePVSurvival (px, qx, cashFlows$premiums_advance, cashFlows$premiums_arrears, m=premiumFrequency, mCorrection=premiumFrequencyCorrection, v=self$v), premiums = calculatePVSurvival (px, qx, cashFlows$premiums_advance, cashFlows$premiums_arrears, m=premiumFrequency, mCorrection=premiumFrequencyCorrection, v=self$v),
guaranteed = calculatePVGuaranteed (cashFlows$guaranteed_advance, cashFlows$guaranteed_arrears, m=benefitFrequency, mCorrection=benefitFrequencyCorrection, v=self$v), guaranteed = calculatePVGuaranteed (cashFlows$guaranteed_advance, cashFlows$guaranteed_arrears, m=benefitFrequency, mCorrection=benefitFrequencyCorrection, v=self$v),
...@@ -269,7 +273,6 @@ str(qx*0); ...@@ -269,7 +273,6 @@ str(qx*0);
qx = pad0(q$q, len); qx = pad0(q$q, len);
px = pad0(q$p, len); px = pad0(q$p, len);
# str(cashFlowsCosts);
pvc = calculatePVCosts(px, qx, cashFlowsCosts, v=self$v); pvc = calculatePVCosts(px, qx, cashFlowsCosts, v=self$v);
pvc pvc
}, },
...@@ -459,7 +462,7 @@ str(qx*0); ...@@ -459,7 +462,7 @@ str(qx*0);
list("premiums"=premiums, "coefficients"=coefficients) list("premiums"=premiums, "coefficients"=coefficients)
}, },
reserveCalculation = function (premiums, absPresentValues, absCashFlows, sumInsured=1, premiumSum=0, policyPeriod = 1, age = 0, ..., loadings=list()) { reserveCalculation = function (premiums, absPresentValues, absCashFlows, sumInsured=1, premiumSum=0, policyPeriod = 1, age = 0, ..., reserves = c(), loadings=list(), surrenderPenalty = TRUE) {
# Merge a possibly passed loadings override with the defaults of this class: # Merge a possibly passed loadings override with the defaults of this class:
loadings = self$getLoadings(loadings=loadings); loadings = self$getLoadings(loadings=loadings);
# Net, Zillmer and Gross reserves # Net, Zillmer and Gross reserves
...@@ -505,7 +508,10 @@ str(qx*0); ...@@ -505,7 +508,10 @@ str(qx*0);
# The surrender value functions can have arbitrary form, so we store a function # The surrender value functions can have arbitrary form, so we store a function
# here in the tarif and call that, passing the reduction reserve as # here in the tarif and call that, passing the reduction reserve as
# starting point, but also all reserves, cash flows, premiums and present values # starting point, but also all reserves, cash flows, premiums and present values
if (!is.null(self$surrenderValueCalculation)) { if (!surrenderPenalty) {
# No surrender penalty any more (has already been applied to the first contract change!)
surrenderValue = resReduction;
} else if (!is.null(self$surrenderValueCalculation)) {
surrenderValue = self$surrenderValueCalculation( surrenderValue = self$surrenderValueCalculation(
resReduction, reserves=res, premiums=premiums, absPresentValues=absPresentValues, resReduction, reserves=res, premiums=premiums, absPresentValues=absPresentValues,
absCashFlows=absCashFlows, sumInsured=sumInsured, premiumSum=premiumSum, absCashFlows=absCashFlows, sumInsured=sumInsured, premiumSum=premiumSum,
...@@ -530,14 +536,14 @@ str(qx*0); ...@@ -530,14 +536,14 @@ str(qx*0);
getBasicDataTimeseries = function(premiums, reserves, absCashFlows, absPresentValues, sumInsured=1, policyPeriod, premiumPeriod, ...) { getBasicDataTimeseries = function(premiums, reserves, absCashFlows, absPresentValues, sumInsured=1, policyPeriod, premiumPeriod, ...) {
res=cbind( res=cbind(
"PremiumPayment" = c(rep(1, premiumPeriod), rep(0, policyPeriod-premiumPeriod)), "PremiumPayment" = c(rep(1, premiumPeriod), rep(0, policyPeriod-premiumPeriod+1)),
"SumInsured" = rep(sumInsured, policyPeriod), "SumInsured" = c(rep(sumInsured, policyPeriod), 0),
"Premiums" = absCashFlows$premiums_advance + absCashFlows$premiums_arrears, "Premiums" = absCashFlows$premiums_advance + absCashFlows$premiums_arrears,
"InterestRate" = rep(self$i, policyPeriod), "InterestRate" = rep(self$i, policyPeriod+1),
"PolicyDuration" = rep(policyPeriod, policyPeriod), "PolicyDuration" = rep(policyPeriod, policyPeriod+1),
"PremiumPeriod" = rep(premiumPeriod, policyPeriod) "PremiumPeriod" = rep(premiumPeriod, policyPeriod+1)
); );
rownames(res) = 0:(policyPeriod-1); rownames(res) = 0:policyPeriod;
res res
}, },
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment