From 3e8b96a0de0e0a812f43c09092a3b059b64d69c0 Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Mon, 2 May 2016 22:14:23 +0200
Subject: [PATCH] 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.
---
R/InsuranceContract.R | 179 ++++++++++++++++++++++++------------------
R/InsuranceTarif.R | 48 ++++++-----
2 files changed, 129 insertions(+), 98 deletions(-)
diff --git a/R/InsuranceContract.R b/R/InsuranceContract.R
index 6b3121f..f9eab7d 100644
--- a/R/InsuranceContract.R
+++ b/R/InsuranceContract.R
@@ -1,16 +1,15 @@
library(R6)
library(openxlsx);
-# require(xlsx)
-InsuranceContract = R6Class(
- "InsuranceContract",
+InsuranceContract = R6Class("InsuranceContract",
+
public = list(
tarif = NA,
#### Contract settings
params = list(
sumInsured = 1,
- premiumWaiver= 0,
+ premiumWaiver = 0,
YOB = NA,
age = NA,
policyPeriod = Inf,
@@ -24,11 +23,14 @@ InsuranceContract = R6Class(
premiumFrequency = 1,
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
values = list(
+ basicData = NA,
transitionProbabilities = NA,
cashFlowsBasic = NA,
@@ -50,18 +52,15 @@ InsuranceContract = R6Class(
),
#### Keeping the history of all contract changes during its lifetime
- history = list(
-
- ),
+ history = list(),
#### The code:
- initialize = function(tarif, age, policyPeriod,
- premiumPeriod = policyPeriod, sumInsured = 1,
+ initialize = function(tarif, age, sumInsured = 1,
+ policyPeriod, premiumPeriod = policyPeriod, guaranteed = 0,
...,
loadings = list(),
- guaranteed = 0,
premiumPayments = "in advance", benefitPayments = "in advance",
premiumFrequency = 1, benefitFrequency = 1,
deferral = 0, YOB = 1975) {
@@ -83,102 +82,128 @@ InsuranceContract = R6Class(
if (!missing(guaranteed)) self$params$guaranteed = guaranteed;
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) {
- self$history = c(self$history,
- list("time"=time, "comment"=comment, "type"=type, "params"=params, "values"=values));
+ self$history = rbind(self$history,
+ list(time=list("time"=time, "comment"=comment, "type"=type, "params"=params, "values"=values)));
},
- recalculate = function() {
- 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
- },
+ calculateContract = function() {
+ self$values$transitionProbabilities = self$determineTransitionProbabilities();
- determineCashFlows = function() {
- self$values$cashFlowsBasic = do.call(self$tarif$getBasicCashFlows, self$params);
- self$values$cashFlows = do.call(self$tarif$getCashFlows, c(self$params, self$values));
- self$values$premiumSum = sum(self$values$cashFlows$premiums_advance + self$values$cashFlows$premiums_arrears);
- 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)
- },
+ self$values$cashFlowsBasic = self$determineCashFlowsBasic();
+ self$values$cashFlows = self$determineCashFlows();
+ self$values$premiumSum = self$determinePremiumSum();
+ self$values$cashFlowsCosts = self$determineCashFlowsCosts();
- calculatePresentValues = function() {
-str(self$values);
- 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)
- },
+ self$values$presentValues = self$calculatePresentValues();
+ self$values$presentValuesCosts = self$calculatePresentValuesCosts();
- calculatePremiums = function() {
# the premiumCalculation function returns the premiums AND the cofficients,
# 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$premiums = res[["premiums"]]
- self$values$premiums
- },
- updatePresentValues = function() {
- pvAllBenefits = do.call(self$tarif$presentValueBenefits, c(self$params, self$values));
+ # Update the cash flows and present values with the values of the premium
+ pvAllBenefits = self$calculatePresentValuesBenefits()
self$values$presentValues = cbind(self$values$presentValues, pvAllBenefits)
- self$values$presentValue
- },
- calculateAbsCashFlows = function() {
- self$values$absCashFlows = do.call(self$tarif$getAbsCashFlows, c(self$params, self$values));
- self$values$absCashFlows
- },
+ self$values$absCashFlows = self$calculateAbsCashFlows();
+ self$values$absPresentValues = self$calculateAbsPresentValues();
+ self$values$reserves = self$calculateReserves();
+ self$values$basicData = self$getBasicDataTimeseries()
+ self$values$premiumComposition = self$premiumAnalysis();
- calculateAbsPresentValues = function() {
- self$values$absPresentValues = do.call(self$tarif$getAbsPresentValues, c(self$params, self$values));
- self$values$absPresentValues
+ self$addHistorySnapshot(0, "Initial contract values", type="Contract", params=self$params, values = self$values);
},
- calculateReserves = function() {
- self$values$reserves = do.call(self$tarif$reserveCalculation, c(self$params, self$values));
- self$values$reserves
+ determineTransitionProbabilities = function(contractModification=NULL) {
+ do.call(self$tarif$getTransitionProbabilities, c(self$params, self$values, list(contractModification=contractModification)));
},
-
- premiumAnalysis = function() {
- self$values$premiumComposition = do.call(self$tarif$premiumDecomposition, c(self$params, self$values));
- self$values$premiumComposition
+ determineCashFlowsBasic = function(contractModification=NULL) {
+ do.call(self$tarif$getBasicCashFlows, self$params);
+ },
+ 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
# the SumInsured is determined from the available
premiumWaiver = function (t) {
newSumInsured = self$values$reserves[[toString(t), "PremiumFreeSumInsured"]];
- self$premiumWaiver = TRUE;
- self$recalculatePremiumFreeSumInsured(t=t, SumInsured=newSumInsured)
+ self$params$premiumWaiver = TRUE;
+ 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: Update present values from t onwards
- # TODO: Update reserves from t onwards
+ # TODO:
+ # the premiumCalculation function returns the premiums AND the cofficients,
+ # 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
)
);
-
+# InsuranceContract$debug("premiumWaiver")
diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R
index f0a463c..72eb808 100644
--- a/R/InsuranceTarif.R
+++ b/R/InsuranceTarif.R
@@ -1,7 +1,6 @@
library(R6)
-library(lifecontingencies)
+# library(lifecontingencies)
library(objectProperties)
-library(foreach)
TariffTypeEnum = setSingleEnum("TariffType", levels = c("annuity", "wholelife", "endowment", "pureendowment", "terme-fix", "dread-disease"))
PaymentTimeEnum = setSingleEnum("PaymentTime", levels = c("in advance", "in arrears"))
@@ -128,7 +127,7 @@ InsuranceTarif = R6Class(
},
getBasicCashFlows = function(age, ..., guaranteed = 0, policyPeriod = inf, deferral = 0, maxAge = getOmega(self$mortalityTable)) {
maxlen = min(maxAge - age, policyPeriod);
- cf = list(
+ cf = data.frame(
guaranteed = rep(0, maxlen+1),
survival = rep(0, maxlen+1),
death = rep(0, maxlen+1),
@@ -153,7 +152,7 @@ InsuranceTarif = R6Class(
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)) {
cashFlowsBasic = self$getBasicCashFlows(age = age, ..., guaranteed = guaranteed,
policyPeriod = policyPeriod, deferral = deferral, maxAge = maxAge);
@@ -177,11 +176,13 @@ InsuranceTarif = R6Class(
);
# Premiums:
- premiums = pad0(rep(1, min(premiumPeriod, policyPeriod)), cflen);
- if (premiumPayments == "in advance") {
- cf$premiums_advance = premiums;
- } else {
- cf$premiums_arrears = premiums;
+ if (!premiumWaiver) {
+ premiums = pad0(rep(1, min(premiumPeriod, policyPeriod)), cflen);
+ if (premiumPayments == "in advance") {
+ cf$premiums_advance = premiums;
+ } else {
+ cf$premiums_arrears = premiums;
+ }
}
# Survival Benefits
@@ -210,7 +211,7 @@ InsuranceTarif = R6Class(
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;
policyPeriod = min(maxAge - age, policyPeriod);
premiumPeriod = min(policyPeriod, premiumPeriod);
@@ -230,6 +231,11 @@ InsuranceTarif = R6Class(
for (i in 1: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
},
@@ -245,8 +251,6 @@ InsuranceTarif = R6Class(
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"]);
-str(px/px);
-str(qx*0);
pv = cbind(
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),
@@ -269,7 +273,6 @@ str(qx*0);
qx = pad0(q$q, len);
px = pad0(q$p, len);
-# str(cashFlowsCosts);
pvc = calculatePVCosts(px, qx, cashFlowsCosts, v=self$v);
pvc
},
@@ -459,7 +462,7 @@ str(qx*0);
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:
loadings = self$getLoadings(loadings=loadings);
# Net, Zillmer and Gross reserves
@@ -505,7 +508,10 @@ str(qx*0);
# 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
# 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(
resReduction, reserves=res, premiums=premiums, absPresentValues=absPresentValues,
absCashFlows=absCashFlows, sumInsured=sumInsured, premiumSum=premiumSum,
@@ -530,14 +536,14 @@ str(qx*0);
getBasicDataTimeseries = function(premiums, reserves, absCashFlows, absPresentValues, sumInsured=1, policyPeriod, premiumPeriod, ...) {
res=cbind(
- "PremiumPayment" = c(rep(1, premiumPeriod), rep(0, policyPeriod-premiumPeriod)),
- "SumInsured" = rep(sumInsured, policyPeriod),
+ "PremiumPayment" = c(rep(1, premiumPeriod), rep(0, policyPeriod-premiumPeriod+1)),
+ "SumInsured" = c(rep(sumInsured, policyPeriod), 0),
"Premiums" = absCashFlows$premiums_advance + absCashFlows$premiums_arrears,
- "InterestRate" = rep(self$i, policyPeriod),
- "PolicyDuration" = rep(policyPeriod, policyPeriod),
- "PremiumPeriod" = rep(premiumPeriod, policyPeriod)
+ "InterestRate" = rep(self$i, policyPeriod+1),
+ "PolicyDuration" = rep(policyPeriod, policyPeriod+1),
+ "PremiumPeriod" = rep(premiumPeriod, policyPeriod+1)
);
- rownames(res) = 0:(policyPeriod-1);
+ rownames(res) = 0:policyPeriod;
res
},
--
GitLab