diff --git a/Auswertungen/2019-02-27_Bestimmung_Datum.xlsx b/Auswertungen/2019-02-27_Bestimmung_Datum.xlsx
new file mode 100644
index 0000000000000000000000000000000000000000..98f294c02b38517e8c41e5e81d06805aa4093286
Binary files /dev/null and b/Auswertungen/2019-02-27_Bestimmung_Datum.xlsx differ
diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R
index 249c30a8c93b75e5e34001d50a17f2510249c209..b33d073d907940f3fe0f6696108926883bd5d7ee 100644
--- a/R/HelperFunctions.R
+++ b/R/HelperFunctions.R
@@ -59,13 +59,31 @@ deathBenefit.annuityDecreasing = function(interest) {
}
mergeValues = function(starting, ending, t) {
- rbind(starting[1:t,], ending[-1:-t,])
+ # if either starting or ending is missing, always use the other, irrespective of t:
+ if (missing(ending) || is.null(ending)) {
+ starting
+ } else if (missing(starting) || is.null(starting)) {
+ ending
+ } else if (t == 0) {
+ ending
+ } else {
+ rbind(starting[1:t,], ending[-1:-t,])
+ }
}
mergeValues3D = function(starting, ending, t) {
- abind(starting[1:t,,], ending[-1:-t,,], along = 1)
+ # if either starting or ending is missing, always use the other, irrespective of t:
+ if (missing(ending) || is.null(ending)) {
+ starting
+ } else if (missing(starting) || is.null(starting)) {
+ ending
+ } else if (t == 0) {
+ ending
+ } else {
+ abind(starting[1:t,,], ending[-1:-t,,], along = 1)
+ }
}
# Caution: px is not neccessarily 1-qx, because we might also have dread diseases so that px=1-qx-ix! However, the ix is not used for the survival present value
-calculatePVSurvival = function(px=1-qx, qx=1-px, advance, arrears=c(0), ..., m=1, mCorrection = list(alpha=1, beta=0), v=1) {
+calculatePVSurvival = function(px = 1 - qx, qx = 1 - px, advance, arrears = c(0), ..., m = 1, mCorrection = list(alpha = 1, beta = 0), v = 1, start = 0) {
# assuming advance and arrears have the same dimensions...
init = advance[1]*0;
l = max(length(qx), length(advance), length(arrears));
@@ -76,7 +94,7 @@ calculatePVSurvival = function(px=1-qx, qx=1-px, advance, arrears=c(0), ..., m=1
# TODO: Make this work for matrices (i.e. currently advance and arrears are assumed to be one-dimensional vectors)
# TODO: Replace loop by better way (using Reduce?)
res = rep(0, l+1);
- for (i in l:1) {
+ for (i in l:(start + 1)) {
# coefficients for the payments (including corrections for payments during the year (using the alpha(m) and beta(m)):
advcoeff = mCorrection$alpha - mCorrection$beta*(1-p[i]*v);
arrcoeff = mCorrection$alpha - (mCorrection$beta + 1/m)*(1-p[i]*v);
@@ -87,64 +105,64 @@ calculatePVSurvival = function(px=1-qx, qx=1-px, advance, arrears=c(0), ..., m=1
}
-calculatePVGuaranteed = function(advance, arrears=c(0), ..., m=1, mCorrection = list(alpha=1, beta=0), v=1) {
+calculatePVGuaranteed = function(advance, arrears = c(0), ..., m = 1, mCorrection = list(alpha = 1, beta = 0), v = 1, start = 0) {
# assuming advance and arrears have the same dimensions...
init = advance[1]*0;
l = max(length(advance), length(arrears));
- advance = pad0(advance, l, value=init);
- arrears = pad0(arrears, l, value=init);
+ advance = pad0(advance, l, value = init);
+ arrears = pad0(arrears, l, value = init);
# TODO: Make this work for matrices (i.e. currently advance and arrears are assumed to be one-dimensional vectors)
# TODO: Replace loop by better way (using Reduce?)
- res = rep(0, l+1);
- for (i in l:1) {
+ res = rep(0, l + 1);
+ for (i in l:(start + 1)) {
# coefficients for the payments (including corrections for payments during the year (using the alpha(m) and beta(m)):
- advcoeff = mCorrection$alpha - mCorrection$beta*(1-v);
- arrcoeff = mCorrection$alpha - (mCorrection$beta + 1/m)*(1-v);
+ advcoeff = mCorrection$alpha - mCorrection$beta * (1 - v);
+ arrcoeff = mCorrection$alpha - (mCorrection$beta + 1 / m) * (1 - v);
# The actual recursion:
- res[i] = advance[i]*advcoeff + arrears[i]*arrcoeff + v*res[i+1];
+ res[i] = advance[i]*advcoeff + arrears[i]*arrcoeff + v*res[i + 1];
}
res[1:l]
}
# TODO: So far, we are assuming, the costs array has sufficient time steps and does not need to be padded!
-calculatePVCosts = function(px=1-qx, qx=1-px, costs, ..., v=1) {
+calculatePVCosts = function(px = 1 - qx, qx = 1 - px, costs, ..., v = 1, start = 0) {
l = max(length(qx), dim(costs)[1]);
- p = pad0(px, l, value=0);
+ p = pad0(px, l, value = 0);
costs = costs[1:l,,];
# Take the array structure from the cash flow array and initialize it with 0
res = costs*0;
prev = res[1,,]*0;
# Backward recursion starting from the last time:
- for (i in l:1) {
+ for (i in l:(start + 1)) {
# cat("values at iteration ", i, ": ", v, q[i], costs[i,,], prev);
res[i,,] = costs[i,,] + v*p[i]*prev;
- prev=res[i,,];
+ prev = res[i,,];
}
res
}
-calculatePVDeath = function(px, qx, benefits, ..., v=1) {
+calculatePVDeath = function(px, qx, benefits, ..., v = 1, start = 0) {
init = benefits[1]*0; # Preserve the possible array structure of the benefits -> vectorized calculations possible!
l = max(length(qx), length(benefits));
- q = pad0(qx, l, value=1);
- p = pad0(px, l, value=0);
- benefits = pad0(benefits, l, value=init);
+ q = pad0(qx, l, value = 1);
+ p = pad0(px, l, value = 0);
+ benefits = pad0(benefits, l, value = init);
# TODO: Make this work for matrices (i.e. currently benefits are assumed to be one-dimensional vectors)
# TODO: Replace loop by better way (using Reduce?)
- res = rep(init, l+1);
- for (i in l:1) {
+ res = rep(init, l + 1);
+ for (i in l:(start + 1)) {
# Caution: p_x is not neccessarily 1-q_x, because we might also have dread diseases, so that px=1-qx-ix!
- res[i] = v*q[i]*benefits[i] + v*p[i]*res[i+1];
+ res[i] = v * q[i] * benefits[i] + v * p[i] * res[i + 1];
}
res[1:l]
}
-calculatePVDisease = function(px = 1 - qx - ix, qx = 1 - ix - px, ix = 1 - px - qx, benefits, ..., v = 1) {
- init = benefits[1]*0;
+calculatePVDisease = function(px = 1 - qx - ix, qx = 1 - ix - px, ix = 1 - px - qx, benefits, ..., v = 1, start = 0) {
+ init = benefits[1] * 0;
l = min(length(ix), length(qx), length(benefits));
qx = pad0(qx, l, value = 1);
ix = pad0(ix, l, value = 0);
@@ -154,7 +172,7 @@ calculatePVDisease = function(px = 1 - qx - ix, qx = 1 - ix - px, ix = 1 - px -
# TODO: Make this work for matrices (i.e. currently benefits are assumed to be one-dimensional vectors)
# TODO: Replace loop by better way (using Reduce?)
res = rep(init, l + 1);
- for (i in l:1) {
+ for (i in l:(start + 1)) {
res[i] = v * ix[i] * benefits[i] + v * px[i] * res[i + 1];
}
res[1:l]
@@ -195,16 +213,33 @@ correctionPaymentFrequency = function(i, m = 1, order = 0) {
}
#' @export
-pad0 = function(v, l, value=0) {
- if (l >= length(v)) {
- c(v, rep(value, l - length(v)))
- } else {
- v[0:l]
- }
+pad0 = function(v, l, value = 0, start = 0) {
+ # 3 cases: desired length<=start => only 0
+ # desired length within start+v => cut v
+ # desired length longer than start+v => pad with 0/value
+ if (l <= start) {
+ rep(0, l)
+ } else if (start <= l && l <= start + length(v)) {
+ c(rep(0, start), v[0:(l - start)])
+ } else {
+ # Need padding
+ c(rep(0, start), v, rep(value, l - length(v) - start))
+ }
+}
+
+#' Set all entries of the given vector to 0 up until index 'start'
+#' @export
+head0 = function(v, start = 0) {
+ if (start == 0) {
+ v
+ } else {
+ c(rep(0, start), tail(v, -start))
+ }
}
+
#' @export
-padLast = function(v, l) {
- pad0(v, l, tail(v, n = 1))
+padLast = function(v, l, start = 0) {
+ pad0(v, l, value = tail(v, n = 1), start = start)
}
#' Taken from the R Cookbook:
diff --git a/R/InsuranceContract.R b/R/InsuranceContract.R
index 6137a45d93e561b73a346ef0da2d8997e6a86609..09afc3a109a68892c563c8222479ae665bb06bca 100644
--- a/R/InsuranceContract.R
+++ b/R/InsuranceContract.R
@@ -28,6 +28,9 @@ InsuranceContract = R6Class(
#### Caching values for this contract, initialized/calculated when the object is created
Values = InsuranceContract.Values,
+ #### List of all tariff blocks (independently calculated, but combined to one contract, e.g. dynamic/sum increases)
+ blocks = list(),
+
#### Keeping the history of all contract changes during its lifetime
history = list(),
@@ -60,8 +63,7 @@ InsuranceContract = R6Class(
}
self$consolidateContractData(tarif = tarif, ...);
-# browser();
- self$calculateContract(calculate = calculate);
+ self$calculateContract(calculate = calculate, start = self$Parameters$ContractData$blockStart);
},
addHistorySnapshot = function(time = 0, comment = "Initial contract values", type = "Contract", params = self$Parameters, values = self$Values) {
@@ -81,36 +83,36 @@ InsuranceContract = R6Class(
consolidateContractData = function(...) {
args = list(...);
-
+
# Calculate YOB, age, contract closing etc. from each other
# 1. Contract date (if not given) is NOW, unless age + YOB is given => Then year is derived as YOB+age
if (is.null(self$Parameters$ContractData$contractClosing)) {
if (!is.null(self$Parameters$ContractData$age) && !is.null(self$Parameters$ContractData$YOB)) {
# Use current day, but determine year from YOB and age
- self$Parameters$ContractData$contractClosing = Sys.Date() %>%
+ self$Parameters$ContractData$contractClosing = Sys.Date() %>%
'year<-'(self$Parameters$ContractData$YOB + self$Parameters$ContractData$age);
}
}
-
- # 2. Current age: If YOB is given, calculate from contract closing and YOB, otherwise assume 40
+
+ # 2. Current age: If YOB is given, calculate from contract closing and YOB, otherwise assume 40
if (is.null(self$Parameters$ContractData$age)) {
if (is.null(self$Parameters$ContractData$YOB)) {
self$Parameters$ContractData$age = 40; # No information to derive age => Assume 40
warning("InsuranceContract: Missing age, no information to derive age from YOB and contractClosing => Assuming default age 40. Tariff: ", self$tarif$name)
} else {
- self$Parameters$ContractData$age = year(self$Parameters$ContractData$contractClosing) -
+ self$Parameters$ContractData$age = year(self$Parameters$ContractData$contractClosing) -
self$Parameters$ContractData$YOB;
}
}
if (is.null(self$Parameters$ContractData$YOB)) {
self$Parameters$ContractData$YOB = year(self$Parameters$ContractData$contractClosing) - self$Parameters$ContractData$age;
}
-
+
# Evaluate policy period, i.e. if a function is used, calculate its numeric value
self$Parameters$ContractData$policyPeriod = valueOrFunction(
self$Parameters$ContractData$policyPeriod,
params = self$Parameters, values = self$Values);
-
+
#### #
# PREMIUM PAYMENT PERIOD (default: policyPeriod, can be given as function or numeric value)
#### #
@@ -127,7 +129,7 @@ InsuranceContract = R6Class(
self$Parameters$ContractData$deferralPeriod = valueOrFunction(
self$Parameters$ContractData$deferralPeriod,
params = self$Parameters, values = self$Values);
-
+
#### #
# COSTS PARAMETERS: can be a function => evaluate it to get the real costs
#### #
@@ -178,50 +180,105 @@ InsuranceContract = R6Class(
},
- calculateContract = function(calculate = "all") {
- self$Values$transitionProbabilities = self$determineTransitionProbabilities();
+
+
+
+ calculateContract = function(calculate = "all", start = 0, preservePastPV = TRUE, recalculatePremiums = TRUE, recalculatePremiumSum = TRUE) {
+ self$Values$int = self$determineInternalValues(start = start)
+ self$Values$transitionProbabilities = mergeValues(
+ starting = self$Values$transitionProbabilities,
+ ending = self$determineTransitionProbabilities(start = start),
+ t = start)
if (calculate == "probabilities") return();
- self$Values$cashFlowsBasic = self$determineCashFlowsBasic();
- self$Values$cashFlows = self$determineCashFlows();
- self$Values$unitPremiumSum = self$determinePremiumSum();
- self$Values$cashFlowsCosts = self$determineCashFlowsCosts();
+ self$Values$cashFlowsBasic = mergeValues(
+ starting = self$Values$cashFlowsBasic,
+ ending = self$determineCashFlowsBasic(start = start),
+ t = start);
+ self$Values$cashFlows = mergeValues(
+ starting = self$Values$cashFlows,
+ ending = self$determineCashFlows(start = start),
+ t = start);
+
+ if (recalculatePremiumSum) {
+ # Premium waiver: Premium sum is not affected by premium waivers, i.e. everything depending on the premium sum uses the original premium sum!
+ self$Values$unitPremiumSum = self$determinePremiumSum(start = start);
+ }
+ self$Values$cashFlowsCosts = mergeValues3D(
+ starting = self$Values$cashFlowsCosts,
+ ending = self$determineCashFlowsCosts(start = start),
+ t = start);
if (calculate == "cashflows") return();
-
- self$Values$presentValues = self$calculatePresentValues();
- self$Values$presentValuesCosts = self$calculatePresentValuesCosts();
+
+
+ # Shall we re-calculate PV or preserve the old ones???
+ pv = self$calculatePresentValues(start = start)
+ pvCost = self$calculatePresentValuesCosts(start = start)
+ oldPV = self$Values$presentValues
+ if (preservePastPV) {
+ # Preserve past present values, i.e. the PV represents the PV
+ # with the knowledge of the past, even though the future CF
+ # might have changed meanwhile, so the PV at time 0 is no
+ # longer the PV of the current cash flows... The PV at time t
+ # always represents the information available at time t, but no
+ # future chagnes.
+ # This is useful to preserver the PV information neede to
+ # calculate the premiums from the past.
+ if (!is.null(self$Values$presentValues)) {
+ self$Values$presentValues = self$Values$presentValues[1:NCOL(pv)]
+ }
+ self$Values$presentValues = mergeValues(starting = self$Values$presentValues, ending = pv, t = start)
+ self$Values$presentValuesCosts = mergeValues3D(starting = self$Values$presentValuesCosts, ending = pvCost, t = start)
+ } else {
+ # Recalculate present value for times before start, i.e. make all PV consistent with the current cash flows
+ self$Values$presentValues = pv
+ self$Values$presentValuesCosts = pvCost
+ }
if (calculate == "presentvalues") return();
-
+
# 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();
+ res = self$calculatePremiums(start = start);
self$Values$premiumCoefficients = res[["coefficients"]];
+ # TODO: Store premiums in a data.frame???
self$Values$premiums = res[["premiums"]]
+ self$Values$int$premiumCalculationTime = start
if (calculate == "premiums") return();
-
+
+# TODO-start:
+# 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(start = start);
+# 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 = cbind(self$Values$presentValues, pvAllBenefits)
+ pvAllBenefits = self$calculatePresentValuesBenefits(start = start)
+ if (preservePastPV) {
+ self$Values$presentValues = mergeValues(starting = oldPV, ending = cbind(pv, pvAllBenefits), t = start)
+ } else {
+ self$Values$presentValues = cbind(pv, pvAllBenefits)
+ }
- self$Values$absCashFlows = self$calculateAbsCashFlows();
- self$Values$absPresentValues = self$calculateAbsPresentValues();
+ self$Values$absCashFlows = mergeValues(starting = self$Values$absCashFlows, ending = self$calculateAbsCashFlows(start = start), t = start);
+ self$Values$absPresentValues = mergeValues(starting = self$Values$absPresentValues, ending = self$calculateAbsPresentValues(start = start), t = start);
if (calculate == "absvalues") return();
-
- self$Values$reserves = self$calculateReserves();
- self$Values$reservesBalanceSheet = self$calculateReservesBalanceSheet();
+
+ self$Values$reserves = mergeValues(starting = self$Values$reserves, ending = self$calculateReserves(start = start), t = start);
+ self$Values$reservesBalanceSheet = mergeValues(starting = self$Values$reservesBalanceSheet,ending = self$calculateReservesBalanceSheet(start = start), t = start);
if (calculate == "reserves") return();
- self$Values$basicData = self$getBasicDataTimeseries()
- self$Values$premiumComposition = self$premiumAnalysis();
- self$Values$premiumCompositionSums = self$premiumCompositionSums();
- self$Values$premiumCompositionPV = self$premiumCompositionPV();
+ self$Values$basicData = mergeValues(starting = self$Values$basicData, ending = self$getBasicDataTimeseries(start = start), t = start);
+ self$Values$premiumComposition = mergeValues(starting = self$Values$premiumComposition, ending = self$premiumAnalysis(start = start), t = start);
+ self$Values$premiumCompositionSums = mergeValues(starting = self$Values$premiumCompositionSums, ending = self$premiumCompositionSums(start = start), t = start);
+ self$Values$premiumCompositionPV = mergeValues(starting = self$Values$premiumCompositionPV, ending = self$premiumCompositionPV(start = start), t = start);
if (calculate == "premiumcomposition") return();
-
- self$profitParticipation();
+
+ self$profitParticipation(start = start); # TODO-start
if (calculate == "profitparticipation") return();
-
+
self$addHistorySnapshot(
- time = 0,
- comment = "Initial contract values",
+ time = start,
+ comment = ifelse(start == 0, "Initial contract values", paste("Contract recalculation at time ", start)),
type = "Contract",
params = self$Parameters,
values = self$Values
@@ -229,53 +286,57 @@ InsuranceContract = R6Class(
if (calculate == "history") return();
},
- determineTransitionProbabilities = function() {
- self$tarif$getTransitionProbabilities(params = self$Parameters);
+ determineInternalValues = function(start = 0) {
+ self$tarif$getInternalValues(params = self$Parameters, start = start);
+ },
+
+ determineTransitionProbabilities = function(start = 0) {
+ self$tarif$getTransitionProbabilities(params = self$Parameters, values = self$Values, start = start);
},
- determineCashFlowsBasic = function() {
- self$tarif$getBasicCashFlows(params = self$Parameters);
+ determineCashFlowsBasic = function(start = 0) {
+ self$tarif$getBasicCashFlows(params = self$Parameters, values = self$Values, start = start);
},
- determineCashFlows = function() {
- self$tarif$getCashFlows(params = self$Parameters, values = self$Values);
+ determineCashFlows = function(start = 0) {
+ self$tarif$getCashFlows(params = self$Parameters, values = self$Values, start = start);
},
- determinePremiumSum = function() {
+ determinePremiumSum = function(start = 0) {
sum(self$Values$cashFlows$premiums_advance + self$Values$cashFlows$premiums_arrears);
},
- determineCashFlowsCosts = function() {
- self$tarif$getCashFlowsCosts(params = self$Parameters, values = self$Values);
+ determineCashFlowsCosts = function(start = 0) {
+ self$tarif$getCashFlowsCosts(params = self$Parameters, values = self$Values, start = start);
},
- calculatePresentValues = function() {
- self$tarif$presentValueCashFlows(params = self$Parameters, values = self$Values);
+ calculatePresentValues = function(start = 0) {
+ self$tarif$presentValueCashFlows(params = self$Parameters, values = self$Values, start = start);
},
- calculatePresentValuesCosts = function() {
- self$tarif$presentValueCashFlowsCosts(params = self$Parameters, values = self$Values);
+ calculatePresentValuesCosts = function(start = 0) {
+ self$tarif$presentValueCashFlowsCosts(params = self$Parameters, values = self$Values, start = start);
},
- calculatePremiums = function() {
- self$tarif$premiumCalculation(params = self$Parameters, values = self$Values);
+ calculatePremiums = function(start = 0) {
+ self$tarif$premiumCalculation(params = self$Parameters, values = self$Values, start = start);
},
- calculatePresentValuesBenefits = function() {
- self$tarif$presentValueBenefits(params = self$Parameters, values = self$Values);
+ calculatePresentValuesBenefits = function(start = 0) {
+ self$tarif$presentValueBenefits(params = self$Parameters, values = self$Values, start = start);
},
- calculateAbsCashFlows = function() {
- self$tarif$getAbsCashFlows(params = self$Parameters, values = self$Values);
+ calculateAbsCashFlows = function(start = 0) {
+ self$tarif$getAbsCashFlows(params = self$Parameters, values = self$Values, start = start);
},
- calculateAbsPresentValues = function() {
- self$tarif$getAbsPresentValues(params = self$Parameters, values = self$Values);
+ calculateAbsPresentValues = function(start = 0) {
+ self$tarif$getAbsPresentValues(params = self$Parameters, values = self$Values, start = start);
},
- calculateReserves = function() {
- self$tarif$reserveCalculation(params = self$Parameters, values = self$Values);
+ calculateReserves = function(start = 0) {
+ self$tarif$reserveCalculation(params = self$Parameters, values = self$Values, start = start);
},
- calculateReservesBalanceSheet = function() {
- self$tarif$reserveCalculationBalanceSheet(params = self$Parameters, values = self$Values);
+ calculateReservesBalanceSheet = function(start = 0) {
+ self$tarif$reserveCalculationBalanceSheet(params = self$Parameters, values = self$Values, start = start);
},
- premiumAnalysis = function() {
- self$tarif$premiumDecomposition(params = self$Parameters, values = self$Values);
+ premiumAnalysis = function(start = 0) {
+ self$tarif$premiumDecomposition(params = self$Parameters, values = self$Values, start = start);
},
- premiumCompositionSums = function() {
- self$tarif$calculateFutureSums(self$Values$premiumComposition);
+ premiumCompositionSums = function(start = 0) {
+ self$tarif$calculateFutureSums(self$Values$premiumComposition, start = start);
},
- premiumCompositionPV = function() {
- self$tarif$calculatePresentValues(self$Values$premiumComposition, params = self$Parameters);
+ premiumCompositionPV = function(start = 0) {
+ self$tarif$calculatePresentValues(self$Values$premiumComposition, params = self$Parameters, start = start);
},
profitParticipation = function(...) {
@@ -294,7 +355,7 @@ InsuranceContract = R6Class(
},
- getBasicDataTimeseries = function() {
+ getBasicDataTimeseries = function(start = 0) {
self$tarif$getBasicDataTimeseries(params = self$Parameters, values = self$Values);
},
diff --git a/R/InsuranceParameters.R b/R/InsuranceParameters.R
index 3c75578aea3d9b6efb461943395c97b041170833..5895c0d41226635be8cf91f9a9ddc0c2b143a076 100644
--- a/R/InsuranceParameters.R
+++ b/R/InsuranceParameters.R
@@ -95,6 +95,7 @@ InsuranceContract.ParameterDefaults = list(
deferralPeriod = 0, # Aufschubzeit bei Leibrenten
guaranteedPeriod = 0, # Garantiezeit bei Leibrenten
contractClosing = NULL, # Contract closing date (day/month is relevant for balance sheet reserves)
+ blockStart = 0, # When the current tariff block starts (main block starts a 0, dynamic increases start leter!)
premiumPayments = "in advance", # Prämienzahlungsweise (vor-/nachschüssig)
benefitPayments = "in advance", # Leistungszahlungsweise (vor-/nachschüssig)
@@ -166,7 +167,7 @@ InsuranceContract.ParameterDefaults = list(
profitClass = NULL,
profitRates = NULL # General, company-wide profit rates, key columns are year and profitClass
),
-
+
Hooks = list(
# Functions with signature function(x, params, values, ...), default NULL is equivalent to function(x, ...) {x}
adjustCashFlows = NULL,
diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R
index cc1caf8eca422757d3ccc6e1d1151c448f86c2a4..2f0e8b29da4373c0a69962cbc85e547cfc71e975 100644
--- a/R/InsuranceTarif.R
+++ b/R/InsuranceTarif.R
@@ -65,6 +65,20 @@ InsuranceTarif = R6Class(
self$Parameters
},
+ # Get some internal parameters cached (length of data.frames, policy periods cut at max.age, etc.)
+ getInternalValues = function(params, start = 0) {
+ p = c()
+ age = params$ContractData$technicalAge
+ maxAge = getOmega(params$ActuarialBases$mortalityTable)
+ policyPeriod = params$ContractData$policyPeriod
+ list(
+ l = min(maxAge - age, policyPeriod) + 1,
+ policyTerm = min(maxAge - age, policyPeriod),
+ premiumTerm = min(policyPeriod, params$ContractData$premiumPeriod)
+ )
+ },
+
+
getAges = function(params) {
ages = ages(params$ActuarialBases$mortalityTable, YOB = params$ContractData$YOB);
age = params$ContractData$technicalAge;
@@ -74,9 +88,10 @@ InsuranceTarif = R6Class(
ages
},
- getTransitionProbabilities = function(params) {
+ getTransitionProbabilities = function(params, values, start = 0) {
age = params$ContractData$technicalAge;
ages = self$getAges(params);
+ # TODO: Use the start parameter to include possible selection tables (i.e. contract/block starts at time 'start' => qx depend on when contract started, e.g. immediate annuities in DAV 2004-R)
q = deathProbabilities(params$ActuarialBases$mortalityTable, YOB = params$ContractData$YOB, ageDifferences = params$ContractData$ageDifferences);
if (age > 0) {
q = q[-age:-1];
@@ -90,6 +105,7 @@ InsuranceTarif = R6Class(
i = rep(0, length(q));
}
i = pad0(i, length(q));
+ # TODO: Implement case where invalidity/disease does NOT end the contract!
df = data.frame(age = ages, q = q, i = i, p = 1 - q - i, row.names = ages - age)
df
},
@@ -103,144 +119,151 @@ InsuranceTarif = R6Class(
# - for single premiums it will be c(1, 0, 0, ...),
# - for increasing premiums it will be (1+increase)^(0:(premiumPeriod-1))
# and 0 after the premium period
- getPremiumCF = function(len, params, values) {
- premPeriod = min(params$ContractData$premiumPeriod, params$ContractData$policyPeriod, len);
- if (is.null(params$ContractData$premiumIncrease)) {
- pad0(rep(1, premPeriod - 1), len);
+ getPremiumCF = function(len, params, values, start = 0) {
+ premPeriod = min(params$ContractData$premiumPeriod, params$ContractData$policyPeriod, len);
+ if (is.null(params$ContractData$premiumIncrease)) {
+ pad0(rep(1, premPeriod - 1), len, start = start);
+ } else {
+ inc = valueOrFunction(params$ContractData$premiumIncrease, premiumPeriod = premPeriod, params = params, values = values)
+ if (is.vector(inc) && length(inc) > 1) {
+ # If premiumIncrease is (or returns) a vector, treat it as
+ # relative premium amounts, ie. c(1, 1.1, 1.2) means +10% of
+ # the initial premium for the second and third year
+ pad0(inc, len, start = start)
} else {
- inc = valueOrFunction(params$ContractData$premiumIncrease, premiumPeriod = premPeriod, params = params, values = values)
- if (is.vector(inc) && length(inc) > 1) {
- # If premiumIncrease is (or returns) a vector, treat it as
- # relative premium amounts, ie. c(1, 1.1, 1.2) means +10% of
- # the initial premium for the second and third year
- pad0(inc, len)
- } else {
- pad0(inc ^ (0:(premPeriod - 1)), len)
- }
+ pad0(inc ^ (0:(premPeriod - start - 1)), len, start = start)
}
+ }
},
- # Get the unit annuity cash flow (guaranteed and contingent) for the whole annuity payment period.
+ # Get the unit annuity cash flow (guaranteed and contingent) for the whole annuity payment period (after potential deferral period)
# - For constant annuity it will be rep(1, annuityPeriod),
# - for increasing annuities it will be (1+increase)^(0:(premiumPeriod-1))
# and 0 after the premium period
- getAnnuityCF = function(len, params, values) {
- annuityPeriod = min(params$ContractData$policyPeriod - params$ContractData$deferralPeriod, len);
- if (is.null(params$ContractData$annuityIncrease)) {
- pad0(rep(1, annuityPeriod), len);
+ getAnnuityCF = function(len, params, values, start = 0) {
+ annuityPeriod = min(params$ContractData$policyPeriod - params$ContractData$deferralPeriod, len);
+ if (is.null(params$ContractData$annuityIncrease)) {
+ pad0(rep(1, annuityPeriod), len, start = start);
+ } else {
+ inc = valueOrFunction(params$ContractData$annuityIncrease, annuityPeriod = annuityPeriod, params = params, values = values)
+ if (is.vector(inc) && length(inc) > 1) {
+ # If annuityIncrease is (or returns) a vector, treat it as
+ # relative annuity amounts, ie. c(1, 1.1, 1.2) means +10% of
+ # the initial annuity for the second and third year
+ pad0(inc, len, start = start)
} else {
- inc = valueOrFunction(params$ContractData$annuityIncrease, annuityPeriod = annuityPeriod, params = params, values = values)
- if (is.vector(inc) && length(inc) > 1) {
- # If annuityIncrease is (or returns) a vector, treat it as
- # relative annuity amounts, ie. c(1, 1.1, 1.2) means +10% of
- # the initial annuity for the second and third year
- pad0(inc, len)
- } else {
- # a numeric value means constant yearly increases (multiplicative)
- pad0(inc ^ (0:annuityPeriod), len)
- }
+ # a numeric value means constant yearly increases (multiplicative)
+ pad0(inc ^ (0:annuityPeriod), len, start = start)
}
+ }
},
- # Get the unit death cash flow for the whole protection period.
+ # Get the unit death cash flow for the whole protection period (after potential deferral period!)
# - For constant death benefit it will be rep(1, policyPeriod),
# - for linearly decreasing sum insured it will be (policyPeriod:0)/policyPeriod
- getDeathCF = function(len, params, values) {
- period = params$ContractData$policyPeriod - params$ContractData$deferralPeriod;
- if (is.null(params$ContractData$deathBenefit)) {
- pad0(rep(1, period), len)
+ getDeathCF = function(len, params, values, start = 0) {
+ period = params$ContractData$policyPeriod - params$ContractData$deferralPeriod;
+ if (is.null(params$ContractData$deathBenefit)) {
+ pad0(rep(1, period), len, start = start)
+ } else {
+ benefit = valueOrFunction(params$ContractData$deathBenefit, len = len, params = params, values = values)
+ if (is.vector(benefit) && length(benefit) > 1) {
+ # If deathBenefit is (or returns) a vector, treat it as
+ # relative annuity amounts, ie. c(1, 1.1, 1.2) means +10% of
+ # the initial annuity for the second and third year
+ pad0(benefit, len, start = start)
} else {
- benefit = valueOrFunction(params$ContractData$deathBenefit, len = len, params = params, values = values)
- if (is.vector(benefit) && length(benefit) > 1) {
- # If deathBenefit is (or returns) a vector, treat it as
- # relative annuity amounts, ie. c(1, 1.1, 1.2) means +10% of
- # the initial annuity for the second and third year
- pad0(benefit, len)
- } else {
- # constant death benefit
- pad0(rep(benefit, period), len)
- }
+ # constant death benefit
+ pad0(rep(benefit, period), len, start = start)
}
+ }
},
- getBasicCashFlows = function(params) {
- age = params$ContractData$technicalAge;
- maxAge = getOmega(params$ActuarialBases$mortalityTable)
- policyPeriod = params$ContractData$policyPeriod;
- deferralPeriod = params$ContractData$deferralPeriod;
- guaranteedPeriod = params$ContractData$guaranteedPeriod;
- maxlen = min(maxAge - age, policyPeriod);
-
- cf = data.frame(
- guaranteed = rep(0, maxlen + 1),
- survival = rep(0, maxlen + 1),
- death = rep(0, maxlen + 1),
- disease = rep(0, maxlen + 1),
- sumInsured = rep(1, maxlen + 1)
- );
- if (self$tariffType == "annuity") {
- annuityPeriod = maxlen - deferralPeriod;
- annuityCF = self$getAnnuityCF(len = annuityPeriod, params = params, values = values)
- # guaranteed payments exist only with annuities (first n years of the payment)
- cf$guaranteed = c(
- rep(0, deferralPeriod),
- head(annuityCF, n = guaranteedPeriod),
- rep(0, max(0, maxlen + 1 - deferralPeriod - guaranteedPeriod)));
- cf$survival = c(
- rep(0, deferralPeriod + guaranteedPeriod),
- if (guaranteedPeriod > 0) tail(annuityCF, n = -guaranteedPeriod) else annuityCF,
- # rep(1, max(0, maxlen - deferralPeriod - guaranteedPeriod)),
- 0)
- cf$sumInsured = c(
- rep(1, deferralPeriod), # increases/decreases of annuities happen only after deferral!
- annuityCF,
- 0)
-
- } else if (self$tariffType == "terme-fix") {
- cf$guaranteed = c(rep(0, policyPeriod), 1);
-
- } else if (self$tariffType == "dread-disease") {
- cf$disease = c(
- rep(0, deferralPeriod),
- rep(1, maxlen - deferralPeriod),
- 0);
+ getBasicCashFlows = function(params, values, start = 0) {
+ deferralPeriod = params$ContractData$deferralPeriod;
+ guaranteedPeriod = params$ContractData$guaranteedPeriod;
+
+ zeroes = pad0(0, values$int$l)
+
+ cf = data.frame(
+ guaranteed = zeroes,
+ survival = zeroes,
+ death = zeroes,
+ disease = zeroes,
+ sumInsured = c(rep(0, start), rep(1, values$int$l - start))
+ );
+ if (self$tariffType == "annuity") {
+ annuityPeriod = values$int$policyTerm - deferralPeriod;
+ # getAnnuityCF correctly handles start inside and after deferral period!
+ annuityCF = self$getAnnuityCF(len = annuityPeriod, params = params, values = values, start = max(0, start - deferralPeriod))
+ # guaranteed payments exist only with annuities (first n years of the payment)
+ cf$guaranteed = pad0(
+ c(
+ rep(0, deferralPeriod),
+ head(annuityCF, n = guaranteedPeriod)
+ ), values$int$l);
+ cf$survival = pad0(c(
+ rep(0, deferralPeriod + guaranteedPeriod),
+ if (guaranteedPeriod > 0) tail(annuityCF, n = -guaranteedPeriod) else annuityCF,
+ 0), values$int$l)
+
+ if (start <= deferralPeriod) {
+ # start current contract block within deferral period
+ # increases/decreases of annuities happen only after deferral!
+ cf$sumInsured = c(rep(0, start), rep(1, deferralPeriod - start), annuityCF, 0)
} else {
- # For endowments, use the death factor here in the basic death CF
- # to fix the relation of death to survival benefit
- deathCF = self$getDeathCF(maxlen - deferralPeriod, params = params, values = values)
-
- if (self$tariffType == "endowment" || self$tariffType == "pureendowment" || self$tariffType == "endowment + dread-disease") {
- cf$survival = c(rep(0, policyPeriod), 1);
- }
- if (self$tariffType == "endowment" || self$tariffType == "wholelife" || self$tariffType == "endowment + dread-disease") {
- cf$death = c(
- rep(0, deferralPeriod),
- deathCF,
- 0);
- cf$sumInsured = c(
- rep(0, deferralPeriod),
- deathCF,
- 1);
- }
- if (self$tariffType == "endowment + dread-disease") {
- cf$disease = c(
- rep(0, deferralPeriod),
- rep(1, maxlen - deferralPeriod),
- 0);
- }
+ # start current contract block after deferral period
+ cf$sumInsured = c(rep(0, deferralPeriod), annuityCF, 0)
+ }
+
+
+ } else if (self$tariffType == "terme-fix") {
+ # Begin of bock does not have any influence
+ cf$guaranteed = c(rep(0, values$int$policyTerm), 1);
+
+ } else if (self$tariffType == "dread-disease") {
+ # potential Payments start after deferral period and after start of this block
+ cf$disease = c(
+ rep(0, max(deferralPeriod, start)),
+ rep(1, values$int$l - 1 - max(deferralPeriod, start)),
+ 0);
+ } else {
+ # For endowments, use the death factor here in the basic death CF
+ # to fix the relation of death to survival benefit
+ deathCF = self$getDeathCF(values$int$l - 1 - deferralPeriod, params = params, values = values, start = max(0, start - deferralPeriod))
+
+ if (self$tariffType == "endowment" || self$tariffType == "pureendowment" || self$tariffType == "endowment + dread-disease") {
+ cf$survival = c(rep(0, values$int$policyTerm), 1); # start of block does not have any influence!
+ }
+ if (self$tariffType == "endowment" || self$tariffType == "wholelife" || self$tariffType == "endowment + dread-disease") {
+ # start of block already properly handled in deathCF
+ cf$death = c(
+ rep(0, deferralPeriod),
+ deathCF,
+ 0);
+ cf$sumInsured = c(
+ rep(0, deferralPeriod),
+ deathCF,
+ 1);
+ }
+ if (self$tariffType == "endowment + dread-disease") {
+ cf$disease = c(
+ rep(0, max(deferralPeriod, start)),
+ rep(1, values$int$l - 1 - max(deferralPeriod, start)),
+ 0);
}
- cf
+ }
+ cf
},
- getCashFlows = function(params, values) {
+ getCashFlows = function(params, values, start = 0) {
age = params$ContractData$technicalAge;
- maxAge = getOmega(params$ActuarialBases$mortalityTable)
if (is.null(values$cashFlowsBasic)) {
- values$cashFlowsBasic = self$getBasicCashFlows(params);
+ values$cashFlowsBasic = self$getBasicCashFlows(params, values, start = start);
}
- cflen = length(values$cashFlowsBasic$survival);
- zeroes = pad0(0, cflen);
+ cflen = values$int$l
+ zeroes = pad0(0, cflen)
ages = pad0(self$getAges(params), cflen);
cf = data.frame(
premiums_advance = zeroes,
@@ -259,7 +282,7 @@ InsuranceTarif = R6Class(
# Premiums:
if (!params$ContractState$premiumWaiver) {
- premiums = self$getPremiumCF(len = cflen, params = params, values = values)
+ premiums = self$getPremiumCF(len = cflen, params = params, values = values, start = start)
if (params$ContractData$premiumPayments == "in advance") {
cf$premiums_advance = premiums;
} else {
@@ -293,29 +316,21 @@ InsuranceTarif = R6Class(
applyHook(params$Hooks$adjustCashFlows, cf, params, values)
},
- getCashFlowsCosts = function(params, values) {
- age = params$ContractData$technicalAge;
- maxAge = getOmega(params$ActuarialBases$mortalityTable)
- policyPeriod = params$ContractData$policyPeriod;
- premiumPeriod = params$ContractData$premiumPeriod;
-
- maxlen = min(maxAge - age, policyPeriod) + 1;
- policyPeriod = min(maxAge - age, policyPeriod);
- premiumPeriod = min(policyPeriod, premiumPeriod);
-
+ getCashFlowsCosts = function(params, values, start = 0) {
+ # Cost cash flows start at block start time (function argument "start" => one-off alpha costs start are charged at that time!)
dm = dim(params$Costs);
dmnames = dimnames(params$Costs);
- cf = array(0, dim = list(maxlen, dm[1], dm[2]), dimnames = list(0:(maxlen - 1), dmnames[[1]], dmnames[[2]]));
- cf[1,,] = cf[1,,] + params$Costs[,,"once"]
- for (i in 1:premiumPeriod) {
+ cf = array(0, dim = list(values$int$l, dm[1], dm[2]), dimnames = list(0:(values$int$l - 1), dmnames[[1]], dmnames[[2]]));
+ cf[start + 1,,] = cf[start + 1,,] + params$Costs[,,"once"]
+ for (i in (start + 1):values$int$premiumTerm) {
cf[i,,] = cf[i,,] + params$Costs[,,"PremiumPeriod"];
}
- if (premiumPeriod < policyPeriod) {
- for (i in (premiumPeriod + 1):policyPeriod) {
+ if (values$int$premiumTerm < values$int$policyTerm) {
+ for (i in (max(start, values$int$premiumTerm) + 1):values$int$policyTerm) {
cf[i,,] = cf[i,,] + params$Costs[,,"PremiumFree"];
}
}
- for (i in 1:policyPeriod) {
+ for (i in (start + 1):values$int$policyTerm) {
cf[i,,] = cf[i,,] + params$Costs[,,"PolicyPeriod"];
}
@@ -331,79 +346,78 @@ InsuranceTarif = R6Class(
applyHook(params$Hooks$adjustCashFlowsCosts, cf, params, values)
},
- presentValueCashFlows = function(cashFlows, params, values) {
+ presentValueCashFlows = function(cashFlows, params, values, start = 0) {
- len = length(values$cashFlows$premiums_advance);
qq = self$getTransitionProbabilities(params);
- qx = pad0(qq$q, len);
- ix = pad0(qq$i, len);
- px = pad0(qq$p, len);
+ qx = pad0(qq$q, values$int$l);
+ ix = pad0(qq$i, values$int$l);
+ px = pad0(qq$p, values$int$l);
i = params$ActuarialBases$i;
v = 1/(1 + i);
benefitFreqCorr = correctionPaymentFrequency(i = i,
- m = params$ContractData$benefitFrequency,
- order = params$ActuarialBases$benefitFrequencyOrder);
+ m = params$ContractData$benefitFrequency,
+ order = params$ActuarialBases$benefitFrequencyOrder);
premiumFreqCorr = correctionPaymentFrequency(i = i,
- m = params$ContractData$premiumFrequency,
- order = params$ActuarialBases$premiumFrequencyOrder);
+ m = params$ContractData$premiumFrequency,
+ order = params$ActuarialBases$premiumFrequencyOrder);
+ # TODO: Calculate all present values only from start time of block onwards!
pvRefund = calculatePVDeath(
- px, qx,
- values$cashFlows$death_GrossPremium,
- v = v);
+ px, qx,
+ values$cashFlows$death_GrossPremium,
+ v = v, start = start);
pvRefundPast = calculatePVDeath(
- px, qx,
- values$cashFlows$death_Refund_past,
- v = v) * (values$cashFlows[,"death_GrossPremium"] - values$cashFlows[,"premiums_advance"]);
+ px, qx,
+ values$cashFlows$death_Refund_past,
+ v = v, start = start) * (values$cashFlows[,"death_GrossPremium"] - values$cashFlows[,"premiums_advance"]);
pv = cbind(
premiums = calculatePVSurvival(
- px, qx,
- values$cashFlows$premiums_advance, values$cashFlows$premiums_arrears,
- m = params$ContractData$premiumFrequency, mCorrection = premiumFreqCorr,
- v = v),
+ px, qx,
+ values$cashFlows$premiums_advance, values$cashFlows$premiums_arrears,
+ m = params$ContractData$premiumFrequency, mCorrection = premiumFreqCorr,
+ v = v, start = start),
guaranteed = calculatePVGuaranteed(
- values$cashFlows$guaranteed_advance, values$cashFlows$guaranteed_arrears,
- m = params$ContractData$benefitFrequency, mCorrection = benefitFreqCorr,
- v = v),
+ values$cashFlows$guaranteed_advance, values$cashFlows$guaranteed_arrears,
+ m = params$ContractData$benefitFrequency, mCorrection = benefitFreqCorr,
+ v = v, start = start),
survival = calculatePVSurvival(
- px, qx,
- values$cashFlows$survival_advance, values$cashFlows$survival_arrears,
- m = params$ContractData$benefitFrequency, mCorrection = benefitFreqCorr,
- v = v),
+ px, qx,
+ values$cashFlows$survival_advance, values$cashFlows$survival_arrears,
+ m = params$ContractData$benefitFrequency, mCorrection = benefitFreqCorr,
+ v = v, start = start),
death_SumInsured = calculatePVDeath(
- px, qx,
- values$cashFlows$death_SumInsured,
- v = v),
+ px, qx,
+ values$cashFlows$death_SumInsured,
+ v = v, start = start),
disease_SumInsured = calculatePVDisease(
- px, qx, ix,
- values$cashFlows$disease_SumInsured, v = v),
+ px, qx, ix,
+ values$cashFlows$disease_SumInsured, v = v, start = start),
death_GrossPremium = pvRefund,
death_Refund_past = pvRefundPast,
death_Refund_future = pvRefund - pvRefundPast,
death_PremiumFree = calculatePVDeath(
- px, qx,
- values$cashFlows$death_PremiumFree, v = v)
+ px, qx,
+ values$cashFlows$death_PremiumFree, v = v, start = start)
);
- rownames(pv) <- pad0(rownames(qq), len);
+ rownames(pv) <- pad0(rownames(qq), values$int$l);
pv
},
- presentValueCashFlowsCosts = function(params, values) {
- len = dim(values$cashFlowsCosts)[1];
+ presentValueCashFlowsCosts = function(params, values, start = 0) {
+ len = values$int$l;
q = self$getTransitionProbabilities(params);
qx = pad0(q$q, len);
px = pad0(q$p, len);
-
v = 1/(1 + params$ActuarialBases$i)
- pvc = calculatePVCosts(px, qx, values$cashFlowsCosts, v = v);
+ pvc = calculatePVCosts(px, qx, values$cashFlowsCosts, v = v, start = start);
pvc
},
# Cost values (CF, present values, etc.) are an Tx5x3 matrix => convert to Tx15 matrix (alpha | Zillmer | beta | gamma)
- costValuesAsMatrix = function(costValues) {
+ costValuesAsMatrix = function(costValues, start = 0) {
dm = dim(costValues);
nm = dimnames(costValues);
colnames = t(outer(nm[[2]], nm[[3]], paste, sep = "."));
@@ -414,7 +428,7 @@ InsuranceTarif = R6Class(
res
},
- getAbsCashFlows = function(params, values) {
+ getAbsCashFlows = function(params, values, start = 0) {
# TODO: Set up a nice list with coefficients for each type of cashflow,
# rather than multiplying each item manually (this also mitigates the risk
@@ -450,7 +464,7 @@ InsuranceTarif = R6Class(
cbind(values$cashFlows, values$cashFlowsCosts)
},
- getAbsPresentValues = function(params, values) {
+ getAbsPresentValues = function(params, values, start = 0) {
pv = values$presentValues;
#pv[,"age"] = pv[,"premiums"];
@@ -472,7 +486,7 @@ InsuranceTarif = R6Class(
},
- presentValueBenefits = function(params, values) {
+ presentValueBenefits = function(params, values, start = 0) {
# TODO: Here we don't use the securityLoading parameter => Shall it be used or are these values to be understood without additional security loading?
benefits = values$presentValues[,"survival"] +
values$presentValues[,"guaranteed"] +
@@ -496,9 +510,10 @@ InsuranceTarif = R6Class(
# When getPremiumCoefficients is called, the values$premiums array has NOT been filled! Instead,
# some of the premium fields (all required for the current calculation) have
# been set in the passed "premiums" argument.
- getPremiumCoefficients = function(type="gross", coeffBenefits, coeffCosts, premiums, params, values) {
+ getPremiumCoefficients = function(type = "gross", coeffBenefits, coeffCosts, premiums, params, values, start = 0) {
# Merge a possibly passed loadings override with the defaults of this class:
securityLoading = valueOrFunction(params$Loadings$security, params = params, values = values);
+ t = as.character(start)
coeff = list(
"SumInsured" = list("benefits" = coeffBenefits*0, "costs" = coeffCosts*0),
@@ -512,7 +527,7 @@ InsuranceTarif = R6Class(
coeff.benefits = (1 + securityLoading);
if (type == "gross") {
# TODO: How to include this into the Zillmer premium calculation?
- coeff.benefits = coeff.benefits * (1 + sum(values$presentValuesCosts["0", c("alpha", "beta", "gamma"), "NetPremium"]) / values$presentValues[["0","premiums"]])
+ coeff.benefits = coeff.benefits * (1 + sum(values$presentValuesCosts[t, c("alpha", "beta", "gamma"), "NetPremium"]) / values$presentValues[[t,"premiums"]])
}
coeff[["SumInsured"]][["benefits"]][["guaranteed"]] = coeff.benefits;
coeff[["SumInsured"]][["benefits"]][["survival"]] = coeff.benefits;
@@ -564,30 +579,36 @@ InsuranceTarif = R6Class(
coeff
},
- premiumCalculation = function(params, values) {
+ premiumCalculation = function(params, values, start = 0) {
loadings = params$Loadings;
sumInsured = params$ContractData$sumInsured
values$premiums = c("unit.net" = 0, "unit.Zillmer" = 0, "unit.gross" = 0, "net" = 0, "Zillmer" = 0, "gross" = 0, "written" = 0);
coefficients = list("gross" = c(), "Zillmer" = c(), "net" = c());
+ # Get the present values of the premiums, claims and costs at time 'start' (where the premium is to be calculated)
+ t = as.character(start)
+ pv = values$presentValues[t,]
+ pvCost = values$presentValuesCosts[t,,]
+
+
# net, gross and Zillmer premiums are calculated from the present values using the coefficients on each present value as described in the formulas document
- coeff = self$getPremiumCoefficients("gross", values$presentValues["0",]*0, values$presentValuesCosts["0",,]*0, premiums = values$premiums, params = params, values = values)
- enumerator = sum(coeff[["SumInsured"]][["benefits"]] * values$presentValues["0",]) + sum(coeff[["SumInsured"]][["costs"]] * values$presentValuesCosts["0",,]);
- denominator = sum(coeff[["Premium" ]][["benefits"]] * values$presentValues["0",]) + sum(coeff[["Premium" ]][["costs"]] * values$presentValuesCosts["0",,]);
+ coeff = self$getPremiumCoefficients("gross", pv * 0, pvCost * 0, premiums = values$premiums, params = params, values = values, start = start)
+ enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pv) + sum(coeff[["SumInsured"]][["costs"]] * pvCost);
+ denominator = sum(coeff[["Premium" ]][["benefits"]] * pv) + sum(coeff[["Premium" ]][["costs"]] * pvCost);
values$premiums[["unit.gross"]] = enumerator/denominator * (1 + loadings$ongoingAlphaGrossPremium);
values$premiums[["gross"]] = values$premiums[["unit.gross"]] * sumInsured;
coefficients[["gross"]] = coeff;
- coeff = self$getPremiumCoefficients("net", values$presentValues["0",]*0, values$presentValuesCosts["0",,]*0, premiums = values$premiums, params = params, values = values)
- enumerator = sum(coeff[["SumInsured"]][["benefits"]] * values$presentValues["0",]) + sum(coeff[["SumInsured"]][["costs"]] * values$presentValuesCosts["0",,]);
- denominator = sum(coeff[["Premium" ]][["benefits"]] * values$presentValues["0",]) + sum(coeff[["Premium" ]][["costs"]] * values$presentValuesCosts["0",,]);
+ coeff = self$getPremiumCoefficients("net", pv*0, pvCost*0, premiums = values$premiums, params = params, values = values, start = start)
+ enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pv) + sum(coeff[["SumInsured"]][["costs"]] * pvCost);
+ denominator = sum(coeff[["Premium" ]][["benefits"]] * pv) + sum(coeff[["Premium" ]][["costs"]] * pvCost);
values$premiums[["unit.net"]] = enumerator/denominator;
values$premiums[["net"]] = values$premiums[["unit.net"]] * sumInsured;
coefficients[["net"]] = coeff;
- coeff = self$getPremiumCoefficients("Zillmer", values$presentValues["0",]*0, values$presentValuesCosts["0",,]*0, premiums = values$premiums, params = params, values = values);
- enumerator = sum(coeff[["SumInsured"]][["benefits"]] * values$presentValues["0",]) + sum(coeff[["SumInsured"]][["costs"]] * values$presentValuesCosts["0",,]);
- denominator = sum(coeff[["Premium" ]][["benefits"]] * values$presentValues["0",]) + sum(coeff[["Premium" ]][["costs"]] * values$presentValuesCosts["0",,]);
+ coeff = self$getPremiumCoefficients("Zillmer", pv * 0, pvCost * 0, premiums = values$premiums, params = params, values = values, start = start);
+ enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pv) + sum(coeff[["SumInsured"]][["costs"]] * pvCost);
+ denominator = sum(coeff[["Premium" ]][["benefits"]] * pv) + sum(coeff[["Premium" ]][["costs"]] * pvCost);
values$premiums[["unit.Zillmer"]] = enumerator/denominator;
values$premiums[["Zillmer"]] = values$premiums[["unit.Zillmer"]] * sumInsured;
coefficients[["Zillmer"]] = coeff;
@@ -614,12 +635,12 @@ InsuranceTarif = R6Class(
partnerRebate = valueOrFunction(loadings$partnerRebate, params = params, values = values);
- pv.unitcosts = values$presentValuesCosts["0","unitcosts","SumInsured"] * sumInsured +
- values$presentValuesCosts["0","unitcosts","SumPremiums"] * values$unitPremiumSum * values$premiums[["gross"]] +
- values$presentValuesCosts["0","unitcosts","GrossPremium"] * values$premiums[["gross"]] +
- values$presentValuesCosts["0","unitcosts","NetPremium"] * values$premiums[["net"]] +
- values$presentValuesCosts["0","unitcosts","Constant"];
- premium.unitcosts = pv.unitcosts / values$presentValues[["0", "premiums"]] + valueOrFunction(loadings$unitcosts, params = params, values = values);
+ pv.unitcosts = pvCost["unitcosts","SumInsured"] * sumInsured +
+ pvCost["unitcosts","SumPremiums"] * values$unitPremiumSum * values$premiums[["gross"]] +
+ pvCost["unitcosts","GrossPremium"] * values$premiums[["gross"]] +
+ pvCost["unitcosts","NetPremium"] * values$premiums[["net"]] +
+ pvCost["unitcosts","Constant"];
+ premium.unitcosts = pv.unitcosts / pv[["premiums"]] + valueOrFunction(loadings$unitcosts, params = params, values = values);
values$premiums[["unitcost"]] = premium.unitcosts;
@@ -635,21 +656,22 @@ InsuranceTarif = R6Class(
list("premiums" = values$premiums, "coefficients" = coefficients)
},
- reserveCalculation = function(params, values) {
+ reserveCalculation = function(params, values, start = 0) {
+ t = as.character(start)
securityFactor = (1 + valueOrFunction(params$Loadings$security, params = params, values = values));
ppScheme = params$ProfitParticipation$profitParticipationScheme;
# Net, Zillmer and Gross reserves
resNet = values$absPresentValues[,"benefitsAndRefund"] * securityFactor - values$premiums[["net"]] * values$absPresentValues[,"premiums.unit"];
- BWZcorr = values$absPresentValues["0", "Zillmer"] / values$absPresentValues["0", "premiums"] * values$absPresentValues[,"premiums"];
+ BWZcorr = values$absPresentValues[t, "Zillmer"] / values$absPresentValues[t, "premiums"] * values$absPresentValues[,"premiums"];
resZ = resNet - BWZcorr;
resAdeq = values$absPresentValues[,"benefitsAndRefund"] * securityFactor +
- values$absPresentValues[,"alpha"] + values$absPresentValues[,"beta"] + values$absPresentValues["gamma"] -
+ values$absPresentValues[,"alpha"] + values$absPresentValues[,"beta"] + values$absPresentValues[,"gamma"] -
values$premiums[["gross"]] * values$absPresentValues[,"premiums.unit"];
#values$premiums[["Zillmer"]] * values$absPresentValues[,"premiums"];
- resGamma = values$absPresentValues[,"gamma"] - values$absPresentValues["0", "gamma"] / values$absPresentValues["0", "premiums"] * values$absPresentValues[,"premiums"]
+ resGamma = values$absPresentValues[,"gamma"] - values$absPresentValues[t, "gamma"] / values$absPresentValues[t, "premiums"] * values$absPresentValues[,"premiums"]
advanceProfitParticipation = 0;
if (!is.null(ppScheme)) {
@@ -657,17 +679,17 @@ InsuranceTarif = R6Class(
}
resConversion = (resZ + resGamma) * (1 - advanceProfitParticipation);
- # Alpha refund: Distribute alpha-costs to 5 year (or if shorter, the policy period):
- r = min(params$ContractData$policyPeriod, 5);
+ # Alpha refund: Distribute alpha-costs to 5 years (or if shorter, the policy period), always starting at time 'start':
+ r = min(params$ContractData$policyPeriod - start, 5);
ZillmerSoFar = Reduce("+", values$absCashFlows$Zillmer, accumulate = TRUE);
ZillmerTotal = sum(values$absCashFlows$Zillmer);
len = length(ZillmerSoFar);
if (params$Features$alphaRefundLinear) {
- ZillmerVerteilungCoeff = pad0((0:r)/r, len, 1);
+ ZillmerVerteilungCoeff = pad0((0:r)/r, len, 1, start = start);
} else {
q = self$getTransitionProbabilities(params);
# vector of all ä_{x+t, r-t}
- pvAlphaTmp = calculatePVSurvival(q = pad0(q$q, len), advance = pad0(rep(1,r), len), v = 1/(1 + params$ActuarialBases$i));
+ pvAlphaTmp = calculatePVSurvival(q = pad0(q$q, len), advance = pad0(rep(1,r), len), v = 1/(1 + params$ActuarialBases$i), start = start);
ZillmerVerteilungCoeff = (1 - pvAlphaTmp/pvAlphaTmp[[1]]);
}
alphaRefund = ZillmerSoFar - ZillmerVerteilungCoeff * ZillmerTotal;
@@ -677,6 +699,7 @@ InsuranceTarif = R6Class(
# Collect all reserves to one large matrix
res = cbind(
+ "SumInsured" = head0(rep(params$ContractData$sumInsured, values$int$l), start = start),
"net" = resNet,
"Zillmer" = resZ,
"adequate" = resAdeq,
@@ -712,8 +735,10 @@ InsuranceTarif = R6Class(
# Calculate new sum insured after premium waiver
Storno = 0; # TODO: Implement storno costs
- newSI = (surrenderValue - values$absPresentValues[,"death_Refund_past"] * securityFactor - c(Storno)) /
- (values$absPresentValues[, "benefits"] * securityFactor + values$absPresentValues[, "gamma_nopremiums"]) * params$ContractData$sumInsured;
+ premiumfreePV = (values$absPresentValues[, "benefits"] * securityFactor + values$absPresentValues[, "gamma_nopremiums"]); # PV of future premium free claims + costs
+ newSI = ifelse(premiumfreePV == 0, 0,
+ (surrenderValue - values$absPresentValues[,"death_Refund_past"] * securityFactor - c(Storno)) /
+ premiumfreePV * params$ContractData$sumInsured);
cbind(res,
"PremiumsPaid" = Reduce("+", values$absCashFlows$premiums_advance, accumulate = TRUE),
@@ -722,7 +747,7 @@ InsuranceTarif = R6Class(
)
},
- getBalanceSheetReserveFactor = function(params, years=1) {
+ getBalanceSheetReserveFactor = function(params, years = 1, start = 0) {
balanceDate = params$ActuarialBases$balanceSheetDate
year(balanceDate) = year(params$ContractData$contractClosing);
if (balanceDate < params$ContractData$contractClosing) {
@@ -744,7 +769,7 @@ InsuranceTarif = R6Class(
baf
},
- reserveCalculationBalanceSheet = function(params, values) {
+ reserveCalculationBalanceSheet = function(params, values, start = 0) {
reserves = values$reserves;
years = length(reserves[,"Zillmer"]);
# Balance sheet reserves:
@@ -792,39 +817,27 @@ InsuranceTarif = R6Class(
},
- getBasicDataTimeseries = function(params, values) {
- # TODO: Find a general solution to cut the policyPeriod at the maximum age (currently this code is duplicated all over!)
- age = params$ContractData$age;
- maxAge = getOmega(params$ActuarialBases$mortalityTable)
- policyPeriod = params$ContractData$policyPeriod;
- maxlen = min(maxAge - age, policyPeriod) + 1;
- policyPeriod = min(maxAge - age, policyPeriod);
- premiumPeriod = min(policyPeriod, params$ContractData$premiumPeriod);
+ getBasicDataTimeseries = function(params, values, start = 0) {
res = cbind(
- "PremiumPayment" = c(
- rep(1, premiumPeriod),
- rep(0, maxlen - premiumPeriod)),
- "SumInsured" = c(
- rep(params$ContractData$sumInsured, policyPeriod),
- 0),
- "Premiums" = c(
- head(values$absCashFlows$premiums_advance + values$absCashFlows$premiums_arrears, premiumPeriod),
- rep(0, maxlen - premiumPeriod)),
- "InterestRate" = rep(params$ActuarialBases$i, maxlen),
- "PolicyDuration" = rep(policyPeriod, maxlen),
- "PremiumPeriod" = rep(premiumPeriod, maxlen)
+ "PremiumPayment" = values$premiumComposition[, "charged"] > 0,
+ "SumInsured" = values$reserves[, "SumInsured"],
+ "Premiums" = values$absCashFlows$premiums_advance + values$absCashFlows$premiums_arrears,
+ "InterestRate" = rep(params$ActuarialBases$i, values$int$l),
+ "PolicyDuration" = rep(values$int$policyTerm, values$int$l),
+ "PremiumPeriod" = rep(values$int$premiumTerm, values$int$l)
);
- rownames(res) = 0:policyPeriod;
+ rownames(res) = 0:(values$int$l-1);
res
},
- premiumDecomposition = function(params, values) {
+ premiumDecomposition = function(params, values, start = 0) {
loadings = params$Loadings;
sumInsured = params$ContractData$sumInsured;
premiums = values$premiums;
v = 1/(1 + params$ActuarialBases$i);
l = dim(values$reserves)[[1]];
ppScheme = params$ProfitParticipation$profitParticipationScheme;
+ t = as.character(start)
# TODO: This assumes all premiums are paid in advance!
premium.gross = values$absCashFlows[,"premiums_advance"];
@@ -893,49 +906,50 @@ InsuranceTarif = R6Class(
# Gross premium = net + zillmeredAlpha + unzillmeredAlpha + beta + gamma premium
unit.premiumCF = premium.gross / premiums[["gross"]];
- premium.gamma = unit.premiumCF * values$absPresentValues["0", "gamma"] / values$absPresentValues["0", "premiums.unit"];
- premium.beta = unit.premiumCF * values$absPresentValues["0", "beta"] / values$absPresentValues["0", "premiums.unit"];
- premium.alpha = unit.premiumCF * values$absPresentValues["0", "alpha"] / values$absPresentValues["0", "premiums.unit"];
+ premium.gamma = unit.premiumCF * values$absPresentValues[t, "gamma"] / values$absPresentValues[t, "premiums.unit"];
+ premium.beta = unit.premiumCF * values$absPresentValues[t, "beta"] / values$absPresentValues[t, "premiums.unit"];
+ premium.alpha = unit.premiumCF * values$absPresentValues[t, "alpha"] / values$absPresentValues[t, "premiums.unit"];
premium.Zillmer = unit.premiumCF * premiums[["Zillmer"]];
- premium.alpha.Zillmer = unit.premiumCF * values$absPresentValues["0", "Zillmer"] / values$absPresentValues["0", "premiums.unit"];
+ premium.alpha.Zillmer = unit.premiumCF * values$absPresentValues[t, "Zillmer"] / values$absPresentValues[t, "premiums.unit"];
premium.alpha.noZ = premium.alpha - premium.alpha.Zillmer; # ungezillmerter Teil der Abschlusskosten
premium.net = unit.premiumCF * premiums[["net"]];
securityLoading = valueOrFunction(params$Loadings$security, params = params, values = values);
- premium.risk.actual = v * (values$absCashFlows[,"death"] - c(values$reserves[,"net"][-1], 0)) * pad0(values$transitionProbabilities$q, l);
+ premium.risk.actual = v * head0(values$absCashFlows[,"death"] - c(values$reserves[,"net"][-1], 0), start = start) * pad0(values$transitionProbabilities$q, l);
premium.risk.security = v * (values$absCashFlows[,"death"] * securityLoading) * pad0(values$transitionProbabilities$q, l);
premium.risk = premium.risk.actual + premium.risk.security;
- premium.risk.disease.actual = v * (values$absCashFlows[,"disease_SumInsured"] - c(values$reserves[,"net"][-1], 0)) * pad0(values$transitionProbabilities$i, l);
+ # TODO-start: Make sure the premium components are 0 before start!
+ premium.risk.disease.actual = v * head0(values$absCashFlows[,"disease_SumInsured"] - c(values$reserves[,"net"][-1], 0), start = start) * pad0(values$transitionProbabilities$i, l);
premium.risk.disease.security = v * (values$absCashFlows[,"disease_SumInsured"] * securityLoading) * pad0(values$transitionProbabilities$i, l);
premium.risk.disease = premium.risk.disease.actual + premium.risk.disease.security;
- premium.savings = getSavingsPremium(
+ premium.savings = head0(getSavingsPremium(
values$reserves[,"net"], v = v,
survival_advance = values$absCashFlows[,"survival_advance"] + values$absCashFlows[,"guaranteed_advance"],
survival_arrears = values$absCashFlows[,"survival_arrears"] + values$absCashFlows[,"guaranteed_arrears"]
- );
+ ), start = start)
- premium.Zillmer.risk.actual = v * (values$absCashFlows[,"death"] - c(values$reserves[,"contractual"][-1], 0)) * pad0(values$transitionProbabilities$q, l);
+ premium.Zillmer.risk.actual = v * head0(values$absCashFlows[,"death"] - c(values$reserves[,"contractual"][-1], 0), start = start) * pad0(values$transitionProbabilities$q, l);
premium.Zillmer.risk.security = v * (values$absCashFlows[,"death"] * securityLoading) * pad0(values$transitionProbabilities$q, l);
premium.Zillmer.risk = premium.Zillmer.risk.actual + premium.Zillmer.risk.security;
- premium.Zillmer.risk.disease.actual = v * (values$absCashFlows[,"disease_SumInsured"] - c(values$reserves[,"contractual"][-1], 0)) * pad0(values$transitionProbabilities$i, l);
+ premium.Zillmer.risk.disease.actual = v * head0(values$absCashFlows[,"disease_SumInsured"] - c(values$reserves[,"contractual"][-1], 0), start = start) * pad0(values$transitionProbabilities$i, l);
premium.Zillmer.risk.disease.security = v * (values$absCashFlows[,"disease_SumInsured"] * securityLoading) * pad0(values$transitionProbabilities$i, l);
premium.Zillmer.risk.disease = premium.Zillmer.risk.disease.actual + premium.Zillmer.risk.disease.security;
- premium.Zillmer.savings = getSavingsPremium(
+ premium.Zillmer.savings = head0(getSavingsPremium(
values$reserves[,"contractual"], v = v,
survival_advance = values$absCashFlows[,"survival_advance"] + values$absCashFlows[,"guaranteed_advance"],
survival_arrears = values$absCashFlows[,"survival_arrears"] + values$absCashFlows[,"guaranteed_arrears"]
- );
- premium.Zillmer.amortization = getSavingsPremium(
+ ), start = start)
+ premium.Zillmer.amortization = head0(getSavingsPremium(
pmin(0, values$reserves[,"contractual"]), v = v
- );
- premium.Zillmer.actsavings = getSavingsPremium(
+ ), start = start)
+ premium.Zillmer.actsavings = head0(getSavingsPremium(
pmax(0, values$reserves[,"contractual"]), v = v,
survival_advance = values$absCashFlows[,"survival_advance"] + values$absCashFlows[,"guaranteed_advance"],
survival_arrears = values$absCashFlows[,"survival_arrears"] + values$absCashFlows[,"guaranteed_arrears"]
- );
+ ), start = start)
res = cbind(
"charged" = premium.charged,
@@ -981,14 +995,17 @@ InsuranceTarif = R6Class(
res
},
- calculateFutureSums = function(values, ...) {
- rcumsum = function(vec) rev(cumsum(rev(vec)));
+ calculateFutureSums = function(values, ..., start = 0) {
+ rcumsum = function(vec) c(
+ head(vec, start),
+ rev(cumsum(rev(tail(vec, length(vec) - start))))
+ )
apply(values, 2, rcumsum)
},
- calculatePresentValues = function(values, params) {
+ calculatePresentValues = function(values, params, start = 0) {
len = dim(values)[1];
q = self$getTransitionProbabilities(params);
- pv = function(vec) calculatePVSurvival(px = pad0(q$p, len), advance = vec, v = 1/(1 + params$ActuarialBases$i));
+ pv = function(vec) calculatePVSurvival(px = pad0(q$p, len), advance = vec, v = 1/(1 + params$ActuarialBases$i), start = start);
apply(values, 2, pv)
},
diff --git a/R/exportInsuranceContract_xlsx.R b/R/exportInsuranceContract_xlsx.R
index 670472180709b6ef040c954b0a53d71b22ad403b..44d2da92699b2858668c4cc131e62babc5817df3 100644
--- a/R/exportInsuranceContract_xlsx.R
+++ b/R/exportInsuranceContract_xlsx.R
@@ -7,9 +7,9 @@ NULL
-################################################
-# Helper Functions
-################################################
+################################################ #
+# Helper Functions ####
+################################################ #
writeAgeQTable = function(wb, sheet, probs, crow = 1, ccol = 1, styles = list()) {
@@ -189,13 +189,13 @@ setInsuranceValuesLabels = function(vals) {
}
-################################################################################
+############################################################################### #
#
# The actual export function
#
# exportInsuranceContract.xlsx(contract, filename)
#
-################################################################################
+############################################################################### #
#' @export
@@ -207,7 +207,7 @@ exportInsuranceContract.xlsx = function(contract, filename) {
qp = contract$Values$transitionProbabilities[1:nrrows,]; # extract the probabilities once, will be needed in every sheet
############################################### #
- # Style information
+ # Style information ####
############################################### #
styles = list(
header = createStyle(border = "TopBottomLeftRight", borderColour = "#DA9694", borderStyle = "medium",
@@ -228,7 +228,7 @@ exportInsuranceContract.xlsx = function(contract, filename) {
);
############################################### #
- # General Workbook setup
+ # General Workbook setup ####
############################################### #
wb = openxlsx::createWorkbook();
@@ -251,7 +251,7 @@ exportInsuranceContract.xlsx = function(contract, filename) {
crow = crow + 4;
############################################### #
- # Basic parameters
+ # Basic parameters ####
############################################### #
values = c(
"Sum insured" = contract$Parameters$ContractData$sumInsured,
@@ -307,9 +307,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
- ################################################
- # Print out Basic contract data as time series
- ################################################
+ ################################################# #
+ # Print out Basic contract data as time series ####
+ ################################################# #
sheet = "Basisdaten";
addWorksheet(wb, sheet);
@@ -346,9 +346,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
- ################################################
- # Print out Reserves
- ################################################
+ ############################################### #
+ # Print out Reserves ####
+ ############################################### #
sheet = "Reserven";
addWorksheet(wb, sheet);
@@ -371,9 +371,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
setColWidths(wb, sheet, cols = 1:50, widths = "auto", ignoreMergedCells = TRUE)
- ################################################
- # Print out Profit Participation
- ################################################
+ ################################################ #
+ # Print out Profit Participation ####
+ ################################################ #
if (!is.null(contract$Values$profitParticipation)) {
sheet = "Gewinnbeteiligung";
@@ -432,9 +432,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
}
- ################################################
- # Print out premium decomposition
- ################################################
+ ############################################### #
+ # Print out premium decomposition ####
+ ############################################### #
# Age, death and survival probabilities
crow = 4;
@@ -462,9 +462,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
setColWidths(wb, sheet, cols = 1:50, widths = "auto", ignoreMergedCells = TRUE)
- ################################################
- # Print out absolute values of present values
- ################################################
+ ################################################ #
+ # Print out absolute values of present values ####
+ ################################################ #
sheet = "abs.Barwerte";
addWorksheet(wb, sheet);
@@ -480,9 +480,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
setColWidths(wb, sheet, cols = 1:50, widths = "auto", ignoreMergedCells = TRUE)
- ################################################
- # Print out absolute values for cash flows
- ################################################
+ ############################################### #
+ # Print out absolute values for cash flows ####
+ ############################################### #
# Age, death and survival probabilities
ccol = 1;
@@ -496,9 +496,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
setColWidths(wb, sheet, cols = 1:50, widths = "auto", ignoreMergedCells = TRUE)
- ################################################
- # Print out present values
- ################################################
+ ############################################### #
+ # Print out present values ####
+ ############################################### #
sheet = "Barwerte";
addWorksheet(wb, sheet);
@@ -510,17 +510,20 @@ exportInsuranceContract.xlsx = function(contract, filename) {
# We add six lines before the present values to show the coefficients for the premium calculation
ccol = ccol + writeAgeQTable(wb, sheet, probs = qp, crow = crow + 6, ccol = 1, styles = styles);
+ # Time the premium was last calculated (i.e. access the present values at that time rather than 0 in the formulas for the premium)
+ tPrem = contract$Values$int$premiumCalculationTime
+
# Store the start/end columns of the coefficients, since we need them later in the formula for the premiums!
w1 = writePremiumCoefficients(wb, sheet, contract$Values$premiumCoefficients, type = "benefits", crow = crow, ccol = ccol - 2, tarif = contract$tarif);
area.premiumcoeff = paste0(int2col(ccol), "%d:", int2col(ccol + w1 - 1), "%d");
- area.premiumvals = paste0("$", int2col(ccol), "$", crow + 6 + 2, ":$", int2col(ccol + w1 - 1), "$", crow + 6 + 2);
+ area.premiumvals = paste0("$", int2col(ccol), "$", crow + 6 + 2 + tPrem, ":$", int2col(ccol + w1 - 1), "$", crow + 6 + 2 + tPrem);
ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(setInsuranceValuesLabels(contract$Values$presentValues)),
crow = crow + 6, ccol = ccol, tableName = "PresentValues_Benefits", styles = styles,
caption = "Leistungsbarwerte", valueStyle = styles$pv0) + 1;
w2 = writePremiumCoefficients(wb, sheet, contract$Values$premiumCoefficients, type = "costs", crow = crow, ccol = ccol - 2, tarif = contract$tarif);
area.costcoeff = paste0(int2col(ccol), "%d:", int2col(ccol + w2 - 1), "%d");
- area.costvals = paste0("$", int2col(ccol), "$", crow + 6 + 2, ":$", int2col(ccol + w2 - 1), "$", crow + 6 + 2);
+ area.costvals = paste0("$", int2col(ccol), "$", crow + 6 + 2 + tPrem, ":$", int2col(ccol + w2 - 1), "$", crow + 6 + 2 + tPrem);
ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(costPV),
crow = crow + 6, ccol = ccol, tableName = "PresentValues_Costs", styles = styles,
caption = "Kostenbarwerte", valueStyle = styles$cost0) + 1;
@@ -542,9 +545,9 @@ exportInsuranceContract.xlsx = function(contract, filename) {
setColWidths(wb, sheet, cols = 1:50, widths = "auto", ignoreMergedCells = TRUE)
- ################################################
- # Print out cash flows
- ################################################
+ ############################################## #
+ # Print out cash flows ####
+ ############################################## #
sheet = "Cash-Flows";
addWorksheet(wb, sheet);
diff --git a/inst/Beispiele/Endowment_Dynamic_From0_Baseline.xlsx b/inst/Beispiele/Endowment_Dynamic_From0_Baseline.xlsx
new file mode 100644
index 0000000000000000000000000000000000000000..1c3fff9eea0c370d183403f308a622513ac23a3d
Binary files /dev/null and b/inst/Beispiele/Endowment_Dynamic_From0_Baseline.xlsx differ
diff --git a/inst/Beispiele/Endowment_Dynamic_From5.xlsx b/inst/Beispiele/Endowment_Dynamic_From5.xlsx
new file mode 100644
index 0000000000000000000000000000000000000000..fd254f947f0b9236fe4a7162967f03c07e28a5f8
Binary files /dev/null and b/inst/Beispiele/Endowment_Dynamic_From5.xlsx differ
diff --git a/inst/Beispiele/Example_Endowment.R b/inst/Beispiele/Example_Endowment.R
new file mode 100644
index 0000000000000000000000000000000000000000..e7fe5ee92e184c8e38d9be9fdb6b74d009ace4e4
--- /dev/null
+++ b/inst/Beispiele/Example_Endowment.R
@@ -0,0 +1,152 @@
+library(LifeInsuranceContracts)
+
+################################################################### #
+# DEFINITION TARIF ####
+################################################################### #
+#
+# Beispieltarif:
+# endowment with regular premiums
+# death benefit = survival benefit
+# Costs: Alpha: 4% of premium sum up-front (2,5% Zillmer)
+# Beta: 5% of each premium paid
+# Gamma: 0,1% of sum insured per year over the whole contract maturity
+# Unitcosts: 10 EUR + 5% Premium Sum (max. 50 EUR), during premium period
+################################################################### #
+
+costs.Bsp = initializeCosts();
+costs.Bsp[["alpha", "SumPremiums", "once"]] = 0.04;
+costs.Bsp[["Zillmer", "SumPremiums", "once"]] = 0.025; # deutsche Beschränkung der Zillmerung
+costs.Bsp[["beta", "GrossPremium", "PremiumPeriod"]] = 0.05;
+costs.Bsp[["gamma", "SumInsured", "PolicyPeriod"]] = 0.001;
+
+costs.Bsp.Unterjaehrigkeit = list("1" = 0.0, "2" = 0.01, "4" = 0.015, "12" = 0.02);
+
+# Stückkosten: 10EUR + 5% PS, maximal 50
+costs.Bsp.Stueckkosten = function (params, values) { min(50, 10 + 0.05*values$premiums[["gross"]]) }
+
+
+surrender.Bsp = function(surrenderReserve, params, values) {
+ n = params$ContractData$policyPeriod - params$ContractData$blockStart;
+ # Rückkaufsabschlag linear fallend von 10 auf 0%:
+ sf = c(rep(0, start), 1 - 0.1 * (1 - (0:n)/n));
+ surrenderReserve * sf
+}
+
+#' @export
+Tarif.Bsp = InsuranceTarif$new(
+ name = "Example Tariff - Standard Endowment",
+ type = "endowment",
+ tarif = "BSP",
+ desc = "Gemischte Versicherung (Standardtarif)",
+ #premiumPeriod = 1,
+ #alphaRefundLinear = FALSE,
+
+ mortalityTable = mort.AT.census.2011.unisex,
+ i = 0.005,
+ costs = costs.Bsp,
+ unitcosts = costs.Bsp.Stueckkosten,
+
+ premiumFrequencyOrder = -1, # Unterjährige Prämienzahlung wird nicht im BW berücksichtigt, sondern durch Prämienaufschlag
+ premiumFrequencyLoading = costs.Bsp.Unterjaehrigkeit,
+ premiumRefund = 0,
+ tax = 0.04,
+
+ surrenderValueCalculation = surrender.Bsp
+);
+
+#
+# contract.Bsp.DynStart = InsuranceContract$new(
+# Tarif.Bsp,
+# age = 45, policyPeriod = 5, premiumPeriod = 5,
+# premiumFrequency = 12,
+# sumInsured = 100000,
+# contractClosing = as.Date("2030-07-01")
+# );
+# exportInsuranceContractExample(contract.Bsp.DynStart, t = 5, basename = "Endowment_Dynamic_From0_Baseline");
+# showVmGlgExamples(contract.Bsp.Dyn, t = 10)
+
+
+contract.Bsp.DynStart$Values$cashFlowsBasic
+contract.Bsp.DynStart$Values$cashFlows
+contract.Bsp.DynStart$Values$cashFlowsCosts
+contract.Bsp.DynStart$Values$presentValues
+
+
+contract.Bsp.Dyn = InsuranceContract$new(
+ Tarif.Bsp,
+ age = 35, policyPeriod = 15, premiumPeriod = 15,
+ premiumFrequency = 12,
+ sumInsured = 100000,
+ contractClosing = as.Date("2020-07-01"),
+ blockStart = 10
+);
+exportInsuranceContract.xlsx(contract.Bsp.Dyn, filename = "Endowment_Dynamic_From5.xlsx");
+
+
+# exportInsuranceContractExample(contract.Bsp.Dyn, t = 5, basename = "Endowment_Dynamic_From5");
+# showVmGlgExamples(contract.Bsp.Dyn, t = 10)
+
+
+contract.Bsp.Dyn$Values$cashFlowsBasic
+contract.Bsp.Dyn$Values$cashFlows
+contract.Bsp.Dyn$Values$cashFlowsCosts
+contract.Bsp.Dyn$Values$presentValues
+contract.Bsp.Dyn$Values$reserves
+contract.Bsp.Dyn$Values$premiumComposition
+
+
+################################################################### #
+# EXAMPLE CONTRACT ####
+################################################################### #
+
+
+contract.Bsp = InsuranceContract$new(
+ Tarif.Bsp,
+ age = 35, policyPeriod = 15, premiumPeriod = 15,
+ premiumFrequency = 12,
+ sumInsured = 100000,
+ contractClosing = as.Date("2020-07-01")
+);
+exportInsuranceContractExample(contract.Bsp, t = 5);
+showVmGlgExamples(contract.Bsp, t = 10)
+
+
+contract.Bsp$Values$cashFlowsBasic
+contract.Bsp$Values$cashFlows
+contract.Bsp$Values$cashFlowsCosts
+contract.Bsp$Values$presentValues
+# contract.U17_3J$Values$presentValuesCosts
+contract.Bsp$Values$premiumSum
+contract.Bsp$Values$premiums
+contract.Bsp$Values$premiumComposition
+contract.Bsp$Values$reserves
+
+
+################################################################### #
+# DYNAMIC INCREASE ####
+################################################################### #
+
+
+contract.Bsp.Dyn = InsuranceContract$new(
+ Tarif.Bsp,
+ age = 35, policyPeriod = 15, premiumPeriod = 15,
+ premiumFrequency = 12,
+ sumInsured = 100000,
+ contractClosing = as.Date("2020-07-01"),
+ blockStart = 10
+);
+exportInsuranceContractExample(contract.Bsp.Dyn, t = 5);
+showVmGlgExamples(contract.Bsp.Dyn, t = 10)
+
+
+contract.Bsp.Dyn$Values$cashFlowsBasic
+contract.Bsp.Dyn$Values$cashFlows
+contract.Bsp.Dyn$Values$cashFlowsCosts
+contract.Bsp.Dyn$Values$presentValues
+# contract.Bsp.Dyn$Values$presentValuesCosts
+contract.Bsp.Dyn$Values$premiumSum
+contract.Bsp.Dyn$Values$premiums
+contract.Bsp.Dyn$Values$premiumComposition
+contract.Bsp.Dyn$Values$reserves
+contract.Bsp.Dyn$Values$basicData
+