diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R
index f825d40e9a9b6ebde2d1abf81ed78091b0ae3bcc..75d525b75f90e0b0954cf23fdca66510c2301507 100644
--- a/R/HelperFunctions.R
+++ b/R/HelperFunctions.R
@@ -1,4 +1,4 @@
-calculatePVSurvival = function(q, advance, arrears, ..., m=1, mCorrection = list(alpha=1, beta=0), v=1) {
+calculatePVSurvival = function(q, advance, arrears=c(0), ..., m=1, mCorrection = list(alpha=1, beta=0), v=1) {
# assuming advance and arrears have the same dimensions...
init = advance[1]*0;
l = max(length(q), length(advance), length(arrears));
diff --git a/R/InsuranceContract.R b/R/InsuranceContract.R
index b2717b944244eb7838c1e7572a58009de67e277a..989379c680938baaa75d66f4e6bcb0b7e2a24457 100644
--- a/R/InsuranceContract.R
+++ b/R/InsuranceContract.R
@@ -8,21 +8,23 @@ InsuranceContract = R6Class(
tarif = NA,
#### Contract settings
- sumInsured = 1,
- YOB = NA,
- age = NA,
- policyPeriod = Inf,
- premiumPeriod = 1,
- deferral = 0,
- guaranteed = 0,
+ params = list(
+ sumInsured = 1,
+ YOB = NA,
+ age = NA,
+ policyPeriod = Inf,
+ premiumPeriod = 1,
+ deferral = 0,
+ guaranteed = 0,
- premiumPayments = PaymentTimeEnum("in advance"),
- benefitPayments = PaymentTimeEnum("in advance"),
+ premiumPayments = PaymentTimeEnum("in advance"),
+ benefitPayments = PaymentTimeEnum("in advance"),
- premiumFrequency = 1,
- benefitFrequency = 1, # Only for annuities!
+ 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)
+ ),
#### Caching values for this contract, initialized/calculated when the object is created
transitionProbabilities = NA,
@@ -35,8 +37,11 @@ InsuranceContract = R6Class(
presentValues = NA,
presentValuesCosts = NA,
- premiums = NA,
premiumCoefficients = NA,
+ premiums = NA,
+ absCashFlows = NA,
+ absPresentValues = NA,
+
reserves = NA,
premiumComposition = NA,
@@ -53,22 +58,22 @@ InsuranceContract = R6Class(
premiumFrequency = 1, benefitFrequency = 1,
deferral = 0, YOB = 1975) {
self$tarif = tarif;
- self$age = age;
- self$policyPeriod = policyPeriod;
- if (missing(premiumPeriod) && !is.na(self$tarif$defaultPremiumPeriod)) {
- self$premiumPeriod = self$tarif$defaultPremiumPeriod;
+ self$params$age = age;
+ self$params$policyPeriod = policyPeriod;
+ if (missing(premiumPeriod) && !is.null(self$tarif$defaultPremiumPeriod)) {
+ self$params$premiumPeriod = self$tarif$defaultPremiumPeriod;
} else {
- self$premiumPeriod = premiumPeriod;
+ self$params$premiumPeriod = premiumPeriod;
}
- self$sumInsured = sumInsured;
- if (!missing(deferral)) self$deferral = deferral;
- if (!missing(YOB)) self$YOB = YOB;
- if (!missing(premiumPayments)) self$premiumPayments = premiumPayments;
- if (!missing(benefitPayments)) self$benefitPayments = benefitPayments;
- if (!missing(premiumFrequency)) self$premiumFrequency = premiumFrequency;
- if (!missing(benefitFrequency)) self$benefitFrequency = benefitFrequency;
- if (!missing(guaranteed)) self$guaranteed = guaranteed;
- if (!missing(loadings)) self$loadings = loadings;
+ self$params$sumInsured = sumInsured;
+ if (!missing(deferral)) self$params$deferral = deferral;
+ if (!missing(YOB)) self$params$YOB = YOB;
+ if (!missing(premiumPayments)) self$params$premiumPayments = premiumPayments;
+ if (!missing(benefitPayments)) self$params$benefitPayments = benefitPayments;
+ if (!missing(premiumFrequency)) self$params$premiumFrequency = premiumFrequency;
+ if (!missing(benefitFrequency)) self$params$benefitFrequency = benefitFrequency;
+ if (!missing(guaranteed)) self$params$guaranteed = guaranteed;
+ if (!missing(loadings)) self$params$loadings = loadings;
self$recalculate();
},
@@ -78,291 +83,104 @@ InsuranceContract = R6Class(
self$determineCashFlows();
self$calculatePresentValues();
self$calculatePremiums();
- self$calculatePresentValuesAllBenefits();
+ self$updatePresentValues(); # Update the cash flows and present values with the values of the premium
+
+ self$calculateAbsCashFlows();
+ self$calculateAbsPresentValues();
self$calculateReserves();
self$premiumAnalysis();
-
},
- exportExcel = function(filename) {
- ###
- nrrows = dim(self$cashFlows)[[1]]; # Some vectors are longer (e.g. qx), so determine the max nr or rows
-
- ################################################
- # Style information
- ################################################
- headerStyle = createStyle(border="TopLeftRight", borderColour="#DA9694", borderStyle="medium", bgFill="#C0504D", fontColour="#FFFFFF", halign="center", valign="center", textDecoration="bold");
- tableHeaderStyle = createStyle(halign="center", valign="center", textDecoration="bold");
- hide0Style = createStyle(numFmt="General; General; \"\"");
- cost0Style = createStyle(numFmt="0.000%; 0.000%; \"\"");
- wrapStyle = createStyle(wrapText=TRUE);
- centerStyle = createStyle(halign="center", valign="center");
-
- ################################################
- # Helper Functions
- ################################################
- writeAgeQTable = function (sheet, crow=1, ccol=1) {
- writeData(wb, sheet, "Sterblichkeiten", startCol = ccol+2, startRow = crow);
- addStyle(wb, sheet, style=headerStyle, rows=crow, cols = ccol+2, stack=TRUE);
- mergeCells(wb, sheet, rows=crow, cols=(ccol+2):(ccol+3))
- writeDataTable(wb, sheet, self$transitionProbabilities[1:nrrows,],
- startRow=crow+1, startCol = ccol, colNames = TRUE, rowNames = TRUE,
- tableStyle = "TableStyleMedium3", withFilter = FALSE, headerStyle = tableHeaderStyle);
- freezePane(wb, sheet, firstActiveRow=crow+2, firstActiveCol = ccol+2)
- addStyle(wb, sheet, style=centerStyle, rows=(crow+2):(crow+1+nrrows), cols=ccol:(ccol+1), gridExpand = TRUE, stack=TRUE);
- dim(self$transitionProbabilities)[[2]] + 2;
- };
- writeValuesTable = function (sheet, values, caption=NULL, crow=1, ccol=1, rowNames=FALSE, tableStyle="TableStyleMedium3", tableName=NULL, withFilter=FALSE, headerStyle=tableHeaderStyle, valueStyle=NULL) {
- nrrow = dim(values)[[1]];
- nrcol = dim(values)[[2]];
- addcol = if (rowNames) 1 else 0;
- ecol = ccol + addcol + nrcol - 1;
- if (!missing(caption)) {
- writeData(wb, sheet, caption, startCol = ccol+addcol, startRow = crow);
- addStyle(wb, sheet, style=headerStyle, rows=crow, cols = ccol+addcol, stack=TRUE);
- mergeCells(wb, sheet, rows=crow, cols=(ccol+addcol):ecol);
- }
- writeDataTable(wb, sheet, values, startRow=crow+1, startCol=ccol, colNames=TRUE,
- rowNames=rowNames, tableStyle=tableStyle,
- tableName=tableName, withFilter = withFilter, headerStyle = headerStyle)
- if (!missing(valueStyle)) {
- addStyle(wb, sheet, style=valueStyle, rows=(crow+2):(crow+nrrow+1), cols=(ccol+addcol):ecol, gridExpand = TRUE, stack = TRUE);
- }
- # width of table is the return value
- nrcol + addcol
- };
-
- writePremiumCoefficients = function(sheet, values, type="benefits", crow=crow, ccol=ccol) {
- writeData(wb, sheet, matrix(c(
- "Nettoprämie", "", "Zillmerprämie", "", "Bruttoprämie", "",
- "rel. zu VS", "rel. zu Prämie", "rel. zu VS", "rel. zu Prämie", "rel. zu VS", "rel. zu Prämie"), 6, 2
- ), startCol = ccol, startRow = crow, colNames = FALSE, borders = "rows", borderColour = "gray5", borderStyle = "thin");
- mergeCells(wb, sheet, cols = ccol, rows = crow:(crow+1));
- mergeCells(wb, sheet, cols = ccol, rows = (crow+2):(crow+3));
- mergeCells(wb, sheet, cols = ccol, rows = (crow+4):(crow+5));
- addStyle(wb, sheet, style=createStyle(valign = "center", borderColour = "gray5", border = "LeftBottomTop", borderStyle = "thin"), rows = crow:(crow+5), cols = ccol);
- mod = function(a) { as.data.frame(t(a)) };
- if (type=="costs") {
- mod = function(vals) {
- newvals=vals;
- dim(newvals) = c(1, dim(vals));
- dimnames(newvals) = c(list("Coeff"), dimnames(vals));
- as.data.frame(self$tarif$costValuesAsMatrix(newvals))
- };
- }
-
- writeData(wb, sheet, mod(values[["net"]][["SumInsured"]][[type]]), startCol = ccol+2, startRow = crow, colNames=FALSE, borders="surrounding", borderColour="gray5", borderStyle="thin");
- writeData(wb, sheet, mod(values[["net"]][["Premium"]][[type]]), startCol = ccol+2, startRow = crow+1, colNames=FALSE, borders="surrounding", borderColour="gray5", borderStyle="thin");
- writeData(wb, sheet, mod(values[["Zillmer"]][["SumInsured"]][[type]]), startCol = ccol+2, startRow = crow+2, colNames=FALSE, borders="surrounding", borderColour="gray5", borderStyle="thin");
- writeData(wb, sheet, mod(values[["Zillmer"]][["Premium"]][[type]]), startCol = ccol+2, startRow = crow+3, colNames=FALSE, borders="surrounding", borderColour="gray5", borderStyle="thin");
- writeData(wb, sheet, mod(values[["gross"]][["SumInsured"]][[type]]), startCol = ccol+2, startRow = crow+4, colNames=FALSE, borders="surrounding", borderColour="gray5", borderStyle="thin");
- writeData(wb, sheet, mod(values[["gross"]][["Premium"]][[type]]), startCol = ccol+2, startRow = crow+5, colNames=FALSE, borders="surrounding", borderColour="gray5", borderStyle="thin");
- }
- # costPV = as.data.frame(self$tarif$costValuesAsMatrix(self$presentValuesCosts));
- # ccol = 1;
- # crow = 4;
- # # We add six lines before the present values to show the coefficients for the premium calculation
- # ccol = ccol + writeAgeQTable("Barwerte", crow=crow+6, ccol=1);
- #
- # ccol = ccol + writeValuesTable("Barwerte", as.data.frame(self$presentValues),
- # crow=crow+6, ccol=ccol, tableName="PresentValues_Benefits",
- # caption = "Leistungsbarwerte", valueStyle=hide0Style) + 1;
- #
- # writePremiumCoefficients("Barwerte", self$premiumCoefficients, type="costs", crow=crow, ccol=ccol-1);
- # ccol = ccol + writeValuesTable("Barwerte", as.data.frame(costPV),
-
-
- ################################################
- # General Workbook setup
- ################################################
- wb = openxlsx::createWorkbook();
- addWorksheet(wb, "Tarifinformationen");
- addWorksheet(wb, "Reserven");
- addWorksheet(wb, "Barwerte");
- addWorksheet(wb, "Cash-Flows");
-
- # Print out general Contract and Tariff information, including results
- crow = 1;
- writeData(wb, "Tarifinformationen", matrix(c(
- "Tarif:", self$tarif$tarif,
- "Tarifname:", self$tarif$name,
- "Description:", self$tarif$desc
- ), 3, 2, byrow = TRUE), startCol=1, startRow=1, colNames=FALSE, rowNames=FALSE);
- mergeCells(wb, "Tarifinformationen", cols=2:10, rows=1);
- mergeCells(wb, "Tarifinformationen", cols=2:10, rows=2);
- mergeCells(wb, "Tarifinformationen", cols=2:10, rows=3);
- addStyle(wb, "Tarifinformationen", style=wrapStyle, rows=3, cols=2:10, stack=TRUE);
- addStyle(wb, "Tarifinformationen", style=createStyle(valign="top"), rows=1:3, cols=1:10, gridExpand=TRUE, stack=TRUE);
-
- crow = crow+4;
-
- ################################################
- # Basic parameters
- ################################################
- values=c(
- "Sum insured"=self$sumInsured,
- "Mortality table"=self$tarif$mortalityTable@name,
- "YOB"=self$YOB,
- "Age"=self$age,
- "Policy duration"=self$policyPeriod,
- "Premium period"=self$premiumPeriod,
- "Deferral"=self$deferral,
- "Guaranteed payments"=self$guaranteed,
- i=self$tarif$i);
-
- writeData(wb, "Tarifinformationen", "Basisdaten des Vertrags und Tarifs", startCol=1, startRow=crow);
- mergeCells(wb, "Tarifinformationen", cols=1:length(values), rows=crow:crow);
- writeDataTable(wb, "Tarifinformationen", as.data.frame(t(values)),
- startCol=1, startRow=crow+1, colNames=TRUE, rowNames=FALSE,
- tableStyle="TableStyleMedium3", withFilter = FALSE, headerStyle = tableHeaderStyle);
- crow = crow + 4;
-
- # Premiums
- writeData(wb, "Tarifinformationen", "Prämien", startCol=1, startRow=crow);
- mergeCells(wb, "Tarifinformationen", cols=1:length(self$premiums), rows=crow:crow);
- writeDataTable(wb, "Tarifinformationen", as.data.frame(t(self$premiums)),
- startCol=1, startRow=crow+1, colNames=TRUE, rowNames=FALSE,
- tableStyle="TableStyleMedium3", withFilter = FALSE, headerStyle = tableHeaderStyle);
- crow = crow + 4;
-
-
- ################################################
- # Print out Reserves and premium decomposition
- ################################################
-
- # Age, death and survival probabilities
- ccol = 1;
- crow = 4;
- ccol = ccol + writeAgeQTable("Reserven", crow=crow, ccol=1);
- ccol = ccol + writeValuesTable("Reserven", as.data.frame(self$reserves),
- crow=crow, ccol=ccol, tableName="Reserves",
- caption="Reserven", valueStyle=hide0Style) + 1;
- ccol = ccol + writeValuesTable("Reserven", as.data.frame(self$premiumComposition),
- crow=crow, ccol=ccol, tableName="Premium_Decomposition",
- caption = "Prämienzerlegung", valueStyle=hide0Style) + 1;
-
-
- ################################################
- # Print out present values
- ################################################
-
- # Age, death and survival probabilities
- costPV = as.data.frame(self$tarif$costValuesAsMatrix(self$presentValuesCosts));
- ccol = 1;
- crow = 4;
- # We add six lines before the present values to show the coefficients for the premium calculation
- ccol = ccol + writeAgeQTable("Barwerte", crow=crow+6, ccol=1);
-
- writePremiumCoefficients("Barwerte", self$premiumCoefficients, type="benefits", crow=crow, ccol=ccol-1);
- ccol = ccol + writeValuesTable("Barwerte", as.data.frame(self$presentValues),
- crow=crow+6, ccol=ccol, tableName="PresentValues_Benefits",
- caption = "Leistungsbarwerte", valueStyle=hide0Style) + 1;
-
- writePremiumCoefficients("Barwerte", self$premiumCoefficients, type="costs", crow=crow, ccol=ccol-2);
- ccol = ccol + writeValuesTable("Barwerte", as.data.frame(costPV),
- crow=crow+6, ccol=ccol, tableName="PresentValues_Costs",
- caption = "Kostenbarwerte", valueStyle=cost0Style) + 1;
-
-
- ################################################
- # Print out cash flows
- ################################################
-
- # Age, death and survival probabilities
- costCF = as.data.frame(self$tarif$costValuesAsMatrix(self$cashFlowsCosts));
- ccol = 1;
- crow = 4;
- ccol = ccol + writeAgeQTable("Cash-Flows", crow=crow, ccol=1);
- ccol = ccol + writeValuesTable("Cash-Flows", self$cashFlows,
- crow=crow, ccol=ccol, tableName="CashFlows_Benefits",
- caption="Leistungscashflows", withFilter=TRUE, valueStyle=hide0Style) + 1;
- ccol = ccol + writeValuesTable("Cash-Flows", costCF,
- crow=crow, ccol=ccol, tableName="CashFlows_Costs",
- caption="Kostencashflows", withFilter=TRUE, valueStyle=cost0Style) + 1;
-
-
- openxlsx::saveWorkbook(wb, filename, overwrite = TRUE)
-
-
- # #### Contract
- # premiumPayments = PaymentTimeEnum("in advance"),
- # benefitPayments = PaymentTimeEnum("in advance"),
- # premiumFrequency = 1,
- # benefitFrequency = 1, # Only for annuities!
- # loadings = list(), # Allow overriding the tariff-defined loadings (see the InsuranceTariff class for all possible names)
- # premiumSum = 0,
- #
- #
- # #### TARIF:
- # tariffType = TariffTypeEnum("wholelife"), # possible values: annuity, wholelife, endowment, pureendowment, terme-fix
- # premiumFrequencyOrder = 0,
- # benefitFrequencyOrder = 0,
- # widowFactor = 0,
- # premiumRefund = 0,
- # premiumRefundLoading = 0, # Mindesttodesfallrisiko soll damit erreicht werden, z.B. 105% der einbezahlten Prämien
- # costs = list(),
- # benefitFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Properly implement this
- # premiumFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Implement this
- # loadings = list( # Loadings can also be function(sumInsured, premiums) # TODO: Add other possible arguments
- # "ongoingAlphaGrossPremium" = 0, # Acquisition cost that increase the gross premium
- # "tax" = 0.04, # insurance tax, factor on each premium paid
- # "unitcosts" = 0, # annual unit cost for each policy (Stückkosten), absolute value
- # "security" = 0, # Additional security loading on all benefit payments, factor on all benefits
- # "noMedicalExam" = 0, # Loading when no medicial exam is done, % of SumInsured
- # "noMedicalExamRelative" = 0, # Loading when no medicial exam is done, % of gross premium
- # "sumRebate" = 0, # gross premium reduction for large premiums, % of SumInsured
- # "premiumRebate" = 0, # gross premium reduction for large premiums, % of gross premium # TODO
- # "advanceProfitParticipation" = 0, # Vorweggewinnbeteiligung (%-Satz der Bruttoprämie)
- # "advanceProfitParticipationInclUnitCost" = 0, # Vorweggewinnbeteiligung (%-Satz der Prämie mit Zu-/Abschlägen, insbesondere nach Stückkosten)
- # "partnerRebate" = 0 # Partnerrabatt auf Prämie mit Zu-/Abschlägen, wenn mehr als 1 Vertrag gleichzeitig abgeschlossen wird, additiv mit advanceBonusInclUnitCost and premiumRebate
- # ),
-
- },
determineTransitionProbabilities = function() {
- self$transitionProbabilities = self$tarif$getTransitionProbabilities(YOB = self$YOB, age = self$age);
+ self$transitionProbabilities = do.call(self$tarif$getTransitionProbabilities, self$params);
self$transitionProbabilities
},
determineCashFlows = function() {
- self$cashFlowsBasic = self$tarif$getBasicCashFlows(YOB = self$YOB, age = self$age, guaranteed = self$guaranteed, deferral = self$deferral, policyPeriod = self$policyPeriod, premiumPeriod = self$premiumPeriod);
- self$cashFlows = self$tarif$getCashFlows(age = self$age, premiumPayments = self$premiumPayments, benefitPayments = self$benefitPayments, policyPeriod = self$policyPeriod, guaranteed = self$guaranteed, deferral = self$deferral, premiumPaymentPeriod = self$premiumPeriod, basicCashFlows = self$cashFlowsBasic);
+ self$cashFlowsBasic = do.call(self$tarif$getBasicCashFlows, self$params);
+ self$cashFlows = do.call(self$tarif$getCashFlows, c(self$params, "basicCashFlows" = self$cashFlowsBasic));
self$premiumSum = sum(self$cashFlows$premiums_advance + self$cashFlows$premiums_arrears);
- self$cashFlowsCosts = self$tarif$getCashFlowsCosts(YOB = self$YOB, age = self$age, deferral = self$deferral, guaranteed = self$guaranteed, premiumPaymentPeriod = self$premiumPeriod, policyPeriod = self$policyPeriod);
+ self$cashFlowsCosts = do.call(self$tarif$getCashFlowsCosts, self$params);
list("benefits"= self$cashFlows, "costs"=self$cashFlowCosts, "premiumSum" = self$premiumSum)
},
calculatePresentValues = function() {
- self$presentValues = self$tarif$presentValueCashFlows(self$cashFlows, age = self$age, YOB = self$YOB, premiumFrequency = self$premiumFrequency, benefitFrequency = self$benefitFrequency, loadings = self$loadings);
- self$presentValuesCosts = self$tarif$presentValueCashFlowsCosts(self$cashFlowsCosts, age = self$age, YOB = self$YOB);
+ self$presentValues = do.call(self$tarif$presentValueCashFlows,
+ c(list("cashflows"=self$cashFlows), self$params));
+ self$presentValuesCosts = do.call(self$tarif$presentValueCashFlowsCosts,
+ c(list("cashflows"=self$cashFlowsCosts), self$params));
list("benefits" = self$presentValues, "costs" = self$presentValuesCosts)
},
- # Add total benefits present value to the PV array. This can only be done after premium calculation, because e.g. premium refund depends on gross premium!
- calculatePresentValuesAllBenefits = function() {
- pvAllBenefits = self$tarif$presentValueBenefits(presentValues = self$presentValues, presentValuesCosts = self$presentValuesCosts, premiums = self$premiums, sumInsured = self$sumInsured, premiumSum = self$premiumSum );
+ 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(list(pvBenefits=self$presentValues,
+ pvCosts=self$presentValuesCosts,
+ premiumSum = self$premiumSum),
+ self$params));
+ self$premiumCoefficients = res[["coefficients"]];
+ self$premiums = res[["premiums"]]
+ self$premiums
+ },
+
+ updatePresentValues = function() {
+ pvAllBenefits = do.call(self$tarif$presentValueBenefits,
+ c(list(presentValues = self$presentValues,
+ presentValuesCosts = self$presentValuesCosts,
+ premiums = self$premiums,
+ premiumSum = self$premiumSum),
+ self$params));
self$presentValues = cbind(self$presentValues, pvAllBenefits)
- self$presentValues
+ self$presentValue
},
- 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 = self$tarif$premiumCalculation(self$presentValues, self$presentValuesCosts, premiumSum = self$premiumSum, sumInsured = self$sumInsured, loadings = self$loadings);
- self$premiumCoefficients = res$coefficients;
- self$premiums = res$premiums
- self$premiums
+ calculateAbsCashFlows = function() {
+ absCashFlows = do.call(self$tarif$getAbsCashFlows,
+ c(list(premiums = self$premiums,
+ premiumSum = self$premiumSum,
+ cashflows = self$cashFlows,
+ cashflowsCosts = self$cashFlowsCosts),
+ self$params));
+ self$absCashFlows = absCashFlows
+ self$absCashFlows
+ },
+
+ calculateAbsPresentValues = function() {
+ absPresentValues = do.call(self$tarif$getAbsPresentValues,
+ c(list(premiums = self$premiums,
+ premiumSum = self$premiumSum,
+ presentValues = self$presentValues,
+ presentValuesCosts = self$presentValuesCosts),
+ self$params));
+ self$absPresentValues = absPresentValues
+ self$absPresentValues
},
calculateReserves = function() {
- self$reserves = self$tarif$reserveCalculation(premiums=self$premiums, pvBenefits=self$presentValues, pvCosts=self$presentValuesCosts, sumInsured=self$sumInsured, premiumSum = self$premiumSum, loadings = self$loadings);
+ self$reserves = do.call(self$tarif$reserveCalculation,
+ c(list(premiums=self$premiums,
+ presentValues=self$absPresentValues,
+ cashflows = self$absCashFlows,
+ premiumSum = self$premiumSum),
+ self$params));
+ self$reserves
},
premiumAnalysis = function() {
- self$premiumComposition = self$tarif$premiumDecomposition(premiums=self$premiums, reserves=self$reserves, pvBenefits=self$presentValues, pvCosts=self$presentValuesCosts, sumInsured=self$sumInsured);
- # self$premiums = cbind(self$premiums, premiumComposition)
- # self$premiums
+ self$premiumComposition = do.call(self$tarif$premiumDecomposition,
+ c(list(premiums=self$premiums,
+ reserves=self$reserves,
+ cashflows=self$absCashFlows,
+ presentValues=self$absPresentValues,
+ q=self$transitionProbabilities),
+ self$params));
+ self$premiumComposition
},
- dummy=NA
+ dummy=NULL
)
);
+
diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R
index be0951f23d6e905b5727cf48d8c3c3ae2c58a334..735e76be0aadafa0ce5be5a32d1435fdf85d49fa 100644
--- a/R/InsuranceTarif.R
+++ b/R/InsuranceTarif.R
@@ -38,7 +38,7 @@ InsuranceTarif = R6Class(
desc = "Description of the contract",
states = c("alive", "dead"),
- mortalityTable = NA,
+ mortalityTable = NULL,
i = 0, # guaranteed interest rate
v = 1, # discount factor
tariffType = TariffTypeEnum("wholelife"), # possible values: annuity, wholelife, endowment, pureendowment, terme-fix
@@ -46,9 +46,10 @@ InsuranceTarif = R6Class(
benefitFrequencyOrder = 0,
widowFactor = 0,
- defaultPremiumPeriod = NA,
+ defaultPremiumPeriod = NULL,
premiumRefund = 0,
premiumRefundLoading = 0, # Mindesttodesfallrisiko soll damit erreicht werden, z.B. 105% der einbezahlten Prämien
+ surrenderValueCalculation = NULL, # By default, not surrender penalties
costs = list(),
benefitFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Properly implement this
@@ -68,11 +69,12 @@ InsuranceTarif = R6Class(
),
features = list( #Special cases for the calculations
- "betaGammaInZillmer" = FALSE # Whether beta and gamma-costs should be included in the Zillmer premium calculation
+ "betaGammaInZillmer" = FALSE, # Whether beta and gamma-costs should be included in the Zillmer premium calculation
+ "alphaRefundLinear" = TRUE # Whether the refund of alpha-costs on surrender is linear in t or follows the NPV of an annuity
),
- initialize = function(name = NA, mortalityTable = NA, i = NA, type = "wholelife", ..., features = list(), premiumPeriod = NA, premiumFrequencyOrder = 0, benefitFrequencyOrder = 0, costs) {
+ initialize = function(name = NULL, mortalityTable = NULL, i = NULL, type = "wholelife", ..., features = list(), premiumPeriod = NULL, premiumFrequencyOrder = 0, benefitFrequencyOrder = 0, costs, surrenderValueCalculation) {
if (!missing(name)) self$name = name;
if (!missing(mortalityTable)) self$mortalityTable = mortalityTable;
if (!missing(i)) self$i = i;
@@ -83,6 +85,7 @@ InsuranceTarif = R6Class(
# Set default premiumPeriod, e.g. single premium, to be used when the contract has no explicit premium period
if (!missing(premiumPeriod)) self$defaultPremiumPeriod = premiumPeriod;
if (!missing(features)) self$features = c(features, self$features);
+ if (!missing(surrenderValueCalculation)) self$surrenderValueCalculation = surrenderValueCalculation;
self$v = 1/(1+self$i);
@@ -101,9 +104,6 @@ InsuranceTarif = R6Class(
if (age > 0) {
q = q[-age:-1];
}
- # p = 1 - q;
- # len = length(p);
- # df = data.frame(p, q=q, rep(0,len), rep(1,len), row.names = ages)
df = data.frame(age=ages, q=q, p=1-q, row.names = ages-age)
df
},
@@ -131,7 +131,7 @@ InsuranceTarif = R6Class(
cf
},
- getCashFlows = function(age, ..., premiumPayments = "in advance", benefitPayments = "in advance", guaranteed = 0, policyPeriod=Inf, premiumPaymentPeriod = policyPeriod, deferral=0, maxAge = getOmega(self$mortalityTable), basicCashFlows = NA) {
+ getCashFlows = function(age, ..., premiumPayments = "in advance", benefitPayments = "in advance", guaranteed = 0, policyPeriod=Inf, premiumPeriod = policyPeriod, deferral=0, maxAge = getOmega(self$mortalityTable), basicCashFlows = NULL) {
if (missing(basicCashFlows)) {
basicCashFlows = self$getBasicCashFlows(age = age, ..., guaranteed = guaranteed,
policyPeriod = policyPeriod, deferral = deferral, maxAge = maxAge);
@@ -153,7 +153,7 @@ InsuranceTarif = R6Class(
);
# Premiums:
- premiums = pad0(rep(1, min(premiumPaymentPeriod, policyPeriod)), cflen);
+ premiums = pad0(rep(1, min(premiumPeriod, policyPeriod)), cflen);
if (premiumPayments == "in advance") {
cf$premiums_advance = premiums;
} else {
@@ -183,10 +183,10 @@ InsuranceTarif = R6Class(
cf
},
- getCashFlowsCosts = function(age, ..., policyPeriod=Inf, premiumPaymentPeriod = policyPeriod, maxAge = getOmega(self$mortalityTable)) {
+ getCashFlowsCosts = function(age, ..., policyPeriod=Inf, premiumPeriod = policyPeriod, maxAge = getOmega(self$mortalityTable)) {
maxlen = min(maxAge - age, policyPeriod)+1;
policyPeriod = min(maxAge - age, policyPeriod);
- premiumPeriod = min(policyPeriod, premiumPaymentPeriod);
+ premiumPeriod = min(policyPeriod, premiumPeriod);
dm = dim(self$costs);
dmnames = dimnames(self$costs);
@@ -210,20 +210,17 @@ InsuranceTarif = R6Class(
len = length(cashflows$premiums_advance);
qq = self$getTransitionProbabilities (age, ...);
q = pad0(qq$q, len);
- ages = pad0(qq$age, len);
benefitFrequencyCorrection = correctionPaymentFrequency(m = benefitFrequency, i = self$i, order = self$benefitFrequencyOrder);
premiumFrequencyCorrection = correctionPaymentFrequency(m = premiumFrequency, i = self$i, order = self$premiumFrequencyOrder);
- # pv = as.matrix(data.frame( # TODO: Find a better way to combine the vectors into a matrix with given row/column names!
- pv = (cbind( # TODO: Find a better way to combine the vectors into a matrix with given row/column names!
- age = ages,
+ pv = cbind(
premiums = calculatePVSurvival (q, cashflows$premiums_advance, cashflows$premiums_arrears, m=premiumFrequency, mCorrection=premiumFrequencyCorrection, v=self$v),
guaranteed = calculatePVSurvival (q*0, cashflows$guaranteed_advance, cashflows$guaranteed_arrears, m=benefitFrequency, mCorrection=benefitFrequencyCorrection, v=self$v),
survival = calculatePVSurvival (q, cashflows$survival_advance, cashflows$survival_arrears, m=benefitFrequency, mCorrection=benefitFrequencyCorrection, v=self$v),
death_SumInsured = calculatePVDeath (q, cashflows$death_SumInsured, v=self$v),
death_GrossPremium = calculatePVDeath (q, cashflows$death_GrossPremium, v=self$v),
death_PremiumFree = calculatePVDeath (q, cashflows$death_PremiumFree, v=self$v)
- ));
+ );
rownames(pv) <- pad0(rownames(qq), len);
pv
},
@@ -248,23 +245,64 @@ InsuranceTarif = R6Class(
dimnames(res) = list(nm[[1]], colnames)
res
},
- presentValueBenefits = function(presentValues, presentValuesCosts, premiums, sumInsured=1, premiumSum=0) {
+
+ getAbsCashFlows = function(cashflows, cashflowsCosts, premiums, sumInsured=1, premiumSum=0, ...) {
+ refundAddon = self$premiumRefundLoading;
+
+ # Multiply each CF column by the corresponding basis
+ cashflows[,c("premiums_advance", "premiums_arrears")] = cashflows[,c("premiums_advance", "premiums_arrears")] * premiums[["gross"]];
+ cashflows[,c("guaranteed_advance", "guaranteed_arrears", "survival_advance", "survival_arrears", "death_SumInsured", "death_PremiumFree")] =
+ cashflows[,c("guaranteed_advance", "guaranteed_arrears", "survival_advance", "survival_arrears", "death_SumInsured", "death_PremiumFree")] * sumInsured;
+ cashflows[,"death_GrossPremium"] = cashflows[,"death_GrossPremium"] * premiums[["gross"]] * (1+refundAddon);
+
+ # Sum all death-related payments to "death" and remove the death_GrossPremium column
+ cashflows[,"death_SumInsured"] = cashflows[,"death_SumInsured"] + cashflows[,"death_GrossPremium"]
+ colnames(cashflows)[colnames(cashflows)=="death_SumInsured"] = "death";
+ cashflows[,"death_GrossPremium"] = NULL;
+
+ cashflowsCosts = cashflowsCosts[,,"SumInsured"] * sumInsured +
+ cashflowsCosts[,,"SumPremiums"] * premiumSum * premiums[["gross"]] +
+ cashflowsCosts[,,"GrossPremium"] * premiums[["gross"]];
+
+ cbind(cashflows, cashflowsCosts)
+ },
+
+ getAbsPresentValues = function(presentValues, premiums, sumInsured=1, premiumSum=0, ...) {
+ refundAddon = self$premiumRefundLoading;
+ pv = presentValues;
+
+ #pv[,"age"] = pv[,"premiums"];
+ #colnames(pv)[colnames(pv)=="age"] = "premiums.unit";
+
+ # Multiply each CF column by the corresponding basis
+ pv[,"premiums"] = pv[,"premiums"] * premiums[["gross"]];
+ pv[,c("guaranteed", "survival", "death_SumInsured", "death_PremiumFree")] =
+ pv[,c("guaranteed", "survival", "death_SumInsured", "death_PremiumFree")] * sumInsured;
+ pv[,"death_GrossPremium"] = pv[,"death_GrossPremium"] * premiums[["gross"]] * (1+refundAddon);
+ pv[,c("benefits", "benefitsAndRefund", "alpha", "Zillmer", "beta", "gamma", "gamma_nopremiums")] =
+ pv[,c("benefits", "benefitsAndRefund", "alpha", "Zillmer", "beta", "gamma", "gamma_nopremiums")] * sumInsured;
+
+ # Sum all death-related payments to "death" and remove the death_GrossPremium column
+ pv[,"death_SumInsured"] = pv[,"death_SumInsured"] + pv[,"death_GrossPremium"]
+ colnames(pv)[colnames(pv)=="death_SumInsured"] = "death";
+
+ cbind("premiums.unit"=presentValues[,"premiums"], pv)
+ },
+
+
+ presentValueBenefits = function(presentValues, presentValuesCosts, premiums, sumInsured=1, premiumSum=0, ...) {
refundAddon = self$premiumRefundLoading;
# 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.unit = presentValues[,"survival"] + presentValues[,"death_SumInsured"];
- benefits = benefits.unit * sumInsured;
- allBenefits.unit = presentValues[,"survival"] + presentValues[,"death_SumInsured"] + presentValues[,"death_GrossPremium"] * premiums[["unit.gross"]] * (1+refundAddon);
- allBenefits = allBenefits.unit * sumInsured;
+ benefits = presentValues[,"survival"] + presentValues[,"death_SumInsured"];
+ allBenefits = presentValues[,"survival"] + presentValues[,"death_SumInsured"] + presentValues[,"death_GrossPremium"] * premiums[["unit.gross"]] * (1+refundAddon);
- benefitsCosts = presentValuesCosts[,,"SumInsured"]*sumInsured +
- presentValuesCosts[,,"SumPremiums"] * premiumSum * premiums[["gross"]] +
- presentValuesCosts[,,"GrossPremium"] * premiums[["gross"]];
+ benefitsCosts = presentValuesCosts[,,"SumInsured"] +
+ presentValuesCosts[,,"SumPremiums"] * premiumSum * premiums[["unit.gross"]] +
+ presentValuesCosts[,,"GrossPremium"] * premiums[["unit.gross"]];
cbind(
- benefits.unit=benefits.unit,
benefits=benefits,
- allBenefits.unit=allBenefits.unit,
- allBenefits=allBenefits,
+ benefitsAndRefund=allBenefits,
benefitsCosts)
},
@@ -274,54 +312,54 @@ InsuranceTarif = R6Class(
securityLoading = loadings$security;
refundAddon = self$premiumRefundLoading;
- coefficients = list(
+ coeff = list(
"SumInsured" = list("benefits" = coeffBenefits*0, "costs" = coeffCosts*0),
"Premium" = list("benefits" = coeffBenefits*0, "costs" = coeffCosts*0)
);
- coefficients[["Premium"]][["benefits"]][["premiums"]] = 1;
+ coeff[["Premium"]][["benefits"]][["premiums"]] = 1;
- coefficients[["SumInsured"]][["benefits"]][["guaranteed"]] = 1+securityLoading;
- coefficients[["SumInsured"]][["benefits"]][["survival"]] = 1+securityLoading;
- coefficients[["SumInsured"]][["benefits"]][["death_SumInsured"]] = 1+securityLoading;
+ coeff[["SumInsured"]][["benefits"]][["guaranteed"]] = 1+securityLoading;
+ coeff[["SumInsured"]][["benefits"]][["survival"]] = 1+securityLoading;
+ coeff[["SumInsured"]][["benefits"]][["death_SumInsured"]] = 1+securityLoading;
# Premium refund is handled differently for gross and net premiums, because it is proportional to the gross premium
if (type == "gross") {
- coefficients[["Premium"]][["benefits"]][["death_GrossPremium"]] = -(1+refundAddon) * (1+securityLoading);
+ coeff[["Premium"]][["benefits"]][["death_GrossPremium"]] = -(1+refundAddon) * (1+securityLoading);
} else if (type=="net" || type=="Zillmer") {
- coefficients[["SumInsured"]][["benefits"]][["death_GrossPremium"]] = premiums[["unit.gross"]] * (1+refundAddon) * (1+securityLoading);
+ coeff[["SumInsured"]][["benefits"]][["death_GrossPremium"]] = premiums[["unit.gross"]] * (1+refundAddon) * (1+securityLoading);
}
# coefficients for the costs
if (type=="gross") {
- coefficients[["SumInsured"]][["costs"]]["alpha", "SumInsured"] = 1;
- coefficients[["SumInsured"]][["costs"]]["beta", "SumInsured"] = 1;
- coefficients[["SumInsured"]][["costs"]]["gamma", "SumInsured"] = 1;
+ coeff[["SumInsured"]][["costs"]]["alpha", "SumInsured"] = 1;
+ coeff[["SumInsured"]][["costs"]]["beta", "SumInsured"] = 1;
+ coeff[["SumInsured"]][["costs"]]["gamma", "SumInsured"] = 1;
# TODO: How to handle beta costs proportional to Sum Insured
- coefficients[["Premium"]][["costs"]]["alpha", "SumPremiums"] = -premiumSum;
- coefficients[["Premium"]][["costs"]]["beta", "SumPremiums"] = -premiumSum;
- coefficients[["Premium"]][["costs"]]["gamma", "SumPremiums"] = -premiumSum;
+ coeff[["Premium"]][["costs"]]["alpha", "SumPremiums"] = -premiumSum;
+ coeff[["Premium"]][["costs"]]["beta", "SumPremiums"] = -premiumSum;
+ coeff[["Premium"]][["costs"]]["gamma", "SumPremiums"] = -premiumSum;
- coefficients[["Premium"]][["costs"]]["alpha", "GrossPremium"] = -1;
- coefficients[["Premium"]][["costs"]]["beta", "GrossPremium"] = -1;
- coefficients[["Premium"]][["costs"]]["gamma", "GrossPremium"] = -1;
+ coeff[["Premium"]][["costs"]]["alpha", "GrossPremium"] = -1;
+ coeff[["Premium"]][["costs"]]["beta", "GrossPremium"] = -1;
+ coeff[["Premium"]][["costs"]]["gamma", "GrossPremium"] = -1;
} else if (type=="Zillmer") {
- coefficients[["SumInsured"]][["costs"]]["Zillmer","SumInsured"] = 1;
- coefficients[["SumInsured"]][["costs"]]["Zillmer","SumPremiums"] = premiumSum * premiums[["unit.gross"]];
- coefficients[["SumInsured"]][["costs"]]["Zillmer","GrossPremium"] = premiums[["unit.gross"]];
+ coeff[["SumInsured"]][["costs"]]["Zillmer","SumInsured"] = 1;
+ coeff[["SumInsured"]][["costs"]]["Zillmer","SumPremiums"] = premiumSum * premiums[["unit.gross"]];
+ coeff[["SumInsured"]][["costs"]]["Zillmer","GrossPremium"] = premiums[["unit.gross"]];
if (self$features$betaGammaInZillmer) {
- coefficients[["SumInsured"]][["costs"]]["beta", "SumInsured"] = 1;
- coefficients[["SumInsured"]][["costs"]]["gamma", "SumInsured"] = 1;
- coefficients[["SumInsured"]][["costs"]]["beta", "SumPremiums"] = premiumSum * premiums[["unit.gross"]];
- coefficients[["SumInsured"]][["costs"]]["gamma", "SumPremiums"] = premiumSum * premiums[["unit.gross"]];
- coefficients[["SumInsured"]][["costs"]]["beta", "GrossPremium"] = premiums[["unit.gross"]];
- coefficients[["SumInsured"]][["costs"]]["gamma", "GrossPremium"] = premiums[["unit.gross"]];
+ coeff[["SumInsured"]][["costs"]]["beta", "SumInsured"] = 1;
+ coeff[["SumInsured"]][["costs"]]["gamma", "SumInsured"] = 1;
+ coeff[["SumInsured"]][["costs"]]["beta", "SumPremiums"] = premiumSum * premiums[["unit.gross"]];
+ coeff[["SumInsured"]][["costs"]]["gamma", "SumPremiums"] = premiumSum * premiums[["unit.gross"]];
+ coeff[["SumInsured"]][["costs"]]["beta", "GrossPremium"] = premiums[["unit.gross"]];
+ coeff[["SumInsured"]][["costs"]]["gamma", "GrossPremium"] = premiums[["unit.gross"]];
}
}
- coefficients
+ coeff
},
premiumCalculation = function(pvBenefits, pvCosts, costs=self$costs, premiumSum=0, sumInsured=1, premiumFrequency = 1, loadings=list(), ...) {
@@ -377,31 +415,75 @@ InsuranceTarif = R6Class(
list("premiums"=premiums, "coefficients"=coefficients)
},
- reserveCalculation = function (premiums, pvBenefits, pvCosts, sumInsured=1, premiumSum=0, ...) {
- resNet = pvBenefits[,"allBenefits"]*(1+self$loadings$security) - premiums[["net"]] * pvBenefits[,"premiums"];
- BWLminBWP = pvBenefits[,"allBenefits"]*(1+self$loadings$security) - premiums[["net"]] * pvBenefits[,"premiums"];
- BWZcorr = pvBenefits["0","Zillmer"]/pvBenefits["0", "premiums"]*pvBenefits[,"premiums"];
- resZ=BWLminBWP - BWZcorr;
+ reserveCalculation = function (premiums, presentValues, cashflows, sumInsured=1, premiumSum=0, policyPeriod = 1, age = 0, ...) {
+ # Net, Zillmer and Gross reserves
+ resNet = presentValues[,"benefitsAndRefund"] * (1+self$loadings$security) - premiums[["net"]] * presentValues[,"premiums.unit"];
+ BWZcorr = presentValues["0", "Zillmer"] / presentValues["0", "premiums"] * presentValues[,"premiums"];
+ resZ = resNet - BWZcorr;
- #premiums[["Zillmer"]] * pvBenefits[,"premiums"];
- res.gamma = pvBenefits[,"gamma"] - pvBenefits["0", "gamma"]/pvBenefits["0", "premiums"]*pvBenefits[,"premiums"]
+ resAdeq = presentValues[,"benefitsAndRefund"] * (1+self$loadings$security) +
+ presentValues[,"alpha"] + presentValues[,"beta"] + presentValues["gamma"] -
+ premiums[["gross"]] * presentValues[,"premiums.unit"];
- # res.premiumfree =
- # res.gamma.premiumfree =
+ #premiums[["Zillmer"]] * presentValues[,"premiums"];
+ resGamma = presentValues[,"gamma"] - presentValues["0", "gamma"] / presentValues["0", "premiums"] * presentValues[,"premiums"]
+
+
+ resConversion = (resZ + resGamma) * (1-self$loadings$advanceProfitParticipation);
+
+ # Alpha refund: Distribute alpha-costs to 5 year (or if shorter, the policy period):
+ r = min(policyPeriod, 5);
+ ZillmerSoFar = Reduce("+", cashflows$Zillmer, accumulate = TRUE);
+ ZillmerTotal = sum(cashflows$Zillmer);
+ len = length(ZillmerSoFar);
+ if (self$features$alphaRefundLinear) {
+ ZillmerVerteilungCoeff = pad0((0:r)/r, len, 1);
+ } else {
+ q = self$getTransitionProbabilities (age, ...);
+ # vector of all ä_{x+t, r-t}
+ pvAlphaTmp = calculatePVSurvival(q = pad0(q$q, len), advance = pad0(rep(1,r), len), v = self$v);
+ ZillmerVerteilungCoeff = (1-pvAlphaTmp/pvAlphaTmp[[1]]);
+ }
+ alphaRefund = ZillmerSoFar - ZillmerVerteilungCoeff * ZillmerTotal;
+
+ # Reduction Reserve: Reserve used for contract modifications:
+ resReduction = pmax(0, resZ+resGamma+alphaRefund) # V_{x,n}^{Rkf}
- res = cbind("net"=resNet, "Zillmer"=resZ, "gamma"=res.gamma
+ # Collect all reserved to one large matrix
+ res = cbind("net"=resNet, "Zillmer"=resZ, "adequate"= resAdeq, "gamma"=resGamma,
+ "contractual"=resZ+resGamma, "conversion"=resConversion, "alphaRefund"=alphaRefund, "reduction"=resReduction
#, "Reserve.premiumfree"=res.premiumfree, "Reserve.gamma.premiumfree"=res.gamma.premiumfree);
);
- rownames(res) <- rownames(pvBenefits);
- res
+ rownames(res) <- rownames(presentValues);
+
+ # 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)) {
+ surrenderValue = self$surrenderValueCalculation(
+ resReduction, reserves=res, premiums=premiums, presentValues=presentValues,
+ cashflows=cashflows, sumInsured=sumInsured, premiumSum=premiumdSum,
+ policyPeriod = policyPeriod, age = age, ...);
+ } else {
+ surrenderValue = resReduction;
+ }
+
+
+ # res.premiumfree =
+ # res.gamma.premiumfree =
+
+ cbind(res, "Surrender"=surrenderValue)
},
- premiumDecomposition = function(premiums, reserves, pvBenefits, pvCosts, sumInsured=1, ...) {
+ premiumDecomposition = function(premiums, reserves, cashflows, presentValues, q, sumInsured=1, ...) {
+ l = dim(reserves)[[1]];
premium.savings = getSavingsPremium(reserves[,"Zillmer"], self$v) + getSavingsPremium(reserves[,"gamma"], self$v);
+ # TODO: Switch to use the Ziller or net or adequate reserve!
+ premium.risk = self$v * (cashflows[,"death"] - c(reserves[,"Zillmer"][-1], 0)) * pad0(q$q, l);
+ # premium.risk = self$v * (cashflows[,"death"] - c(reserves[,"Zillmer"][-1], 0)) * q$q;
- # TODO: Sparprämie,
- res = cbind("savings"=premium.savings);
+ res = cbind("savings"=premium.savings, "risk"=premium.risk, "savings+risk"= premium.savings+premium.risk, "gamma"=cashflows[,"gamma"]);
rownames(res) <- rownames(premiums);
res
},
diff --git a/R/ValuationTables.R b/R/ValuationTables.R
index fcbf247ecd08a0cd302fcb56f24ed02d18cc9ef3..80b5ca1dbebf94d7769de1a78750b88b28858466 100644
--- a/R/ValuationTables.R
+++ b/R/ValuationTables.R
@@ -343,4 +343,4 @@ plotValuationTables = function(data, ..., title = "", legend.position=c(0.9,0.1)
# plotValuationTables(mort.AT.census.1869.male, mort.AT.census.1869.female, mort.AT.census.2011.male, mort.AT.census.2011.female, AVOe2005R.male, AVOe2005R.female, YOB=1972,title="Vergleich österreichische Sterbetafeln, YOB=1972 (bei Generationentafeln)")
#
# plotValuationTables(mort.AT.census.2001.male, AVOe2005R.male, YOB=1972, title="Vergleich österreichische Sterbetafeln")
- plotValuationTables(getCohortTable(AVOe2005R.male, YOB=1972), getCohortTable(AVOe2005R.male, YOB=2016), title="Vergleich österreichische Sterbetafeln")
+# plotValuationTables(getCohortTable(AVOe2005R.male, YOB=1972), getCohortTable(AVOe2005R.male, YOB=2016), title="Vergleich österreichische Sterbetafeln")
diff --git a/R/exportInsuranceContract_xlsx.R b/R/exportInsuranceContract_xlsx.R
new file mode 100644
index 0000000000000000000000000000000000000000..8a3e0aca997edefc80664d9af73c16d594c5c441
--- /dev/null
+++ b/R/exportInsuranceContract_xlsx.R
@@ -0,0 +1,347 @@
+
+################################################
+# Helper Functions
+################################################
+
+
+writeAgeQTable = function (wb, sheet, probs, crow=1, ccol=1, styles=list()) {
+ writeData(wb, sheet, "Sterblichkeiten", startCol = ccol+2, startRow = crow);
+ addStyle(wb, sheet, style=styles$header, rows=crow, cols = ccol+2, stack=TRUE);
+ mergeCells(wb, sheet, rows=crow, cols=(ccol+2):(ccol+3))
+ writeDataTable(wb, sheet, probs,
+ startRow=crow+1, startCol = ccol, colNames = TRUE, rowNames = TRUE,
+ tableStyle = "TableStyleMedium3", withFilter = FALSE, headerStyle = styles$tableHeader);
+ freezePane(wb, sheet, firstActiveRow=crow+2, firstActiveCol = ccol+2)
+ addStyle(wb, sheet, style=styles$center, rows=(crow+2):(crow+1+dim(probs)[[1]]), cols=ccol:(ccol+1), gridExpand = TRUE, stack=TRUE);
+ dim(probs)[[2]] + 2;
+};
+
+writeValuesTable = function (wb, sheet, values, caption=NULL, crow=1, ccol=1, rowNames=FALSE, tableStyle="TableStyleMedium3", tableName=NULL, withFilter=FALSE, headerStyle=styles$tableHeader, valueStyle=NULL) {
+ nrrow = dim(values)[[1]];
+ nrcol = dim(values)[[2]];
+ addcol = if (rowNames) 1 else 0;
+ ecol = ccol + addcol + nrcol - 1;
+ if (!missing(caption)) {
+ writeData(wb, sheet, caption, startCol = ccol+addcol, startRow = crow);
+ addStyle(wb, sheet, style=headerStyle, rows=crow, cols = ccol+addcol, stack=TRUE);
+ mergeCells(wb, sheet, rows=crow, cols=(ccol+addcol):ecol);
+ }
+
+ writeDataTable(wb, sheet, values, startRow=crow+1, startCol=ccol, colNames=TRUE,
+ rowNames=rowNames, tableStyle=tableStyle,
+ tableName=tableName, withFilter = withFilter, headerStyle = headerStyle)
+ if (!missing(valueStyle)) {
+ addStyle(wb, sheet, style=valueStyle, rows=(crow+2):(crow+nrrow+1), cols=(ccol+addcol):ecol, gridExpand = TRUE, stack = TRUE);
+ }
+ # width of table is the return value
+ nrcol + addcol
+};
+
+writePremiumCoefficients = function(wb, sheet, values, tarif=NULL, type="benefits", crow=crow, ccol=ccol) {
+ writeData(wb, sheet, matrix(c(
+ "Nettoprämie", "", "Zillmerprämie", "", "Bruttoprämie", "",
+ "rel. zu VS", "rel. zu Prämie", "rel. zu VS", "rel. zu Prämie", "rel. zu VS", "rel. zu Prämie"), 6, 2
+ ), startCol = ccol, startRow = crow, colNames = FALSE, borders = "rows", borderColour = "gray5", borderStyle = "thin");
+ mergeCells(wb, sheet, cols = ccol, rows = crow:(crow+1));
+ mergeCells(wb, sheet, cols = ccol, rows = (crow+2):(crow+3));
+ mergeCells(wb, sheet, cols = ccol, rows = (crow+4):(crow+5));
+ addStyle(wb, sheet, style=createStyle(halign = "left", valign = "center",
+ borderColour = "gray5", border = "LeftBottomTop",
+ borderStyle = "thin"),
+ rows = crow:(crow+5), cols = ccol);
+ addStyle(wb, sheet, style=createStyle(halign = "right", valign = "center",
+ borderColour = "gray5", border = "RightBottomTop",
+ borderStyle = "thin"),
+ rows = crow:(crow+5), cols = ccol+1);
+
+ # The first column of the benefits coefficients is for "age", which we want to remove
+ mod = function(a) { as.data.frame(t(a)) };
+ if (type=="costs") {
+ mod = function(vals) {
+ vals = setInsuranceValuesLabels(vals);
+ newvals=vals;
+ dimn = dimnames(newvals);
+ dim(newvals) = c(1, dim(vals));
+ dimnames(newvals) = c(list("Coeff"), dimn);
+ as.data.frame(tarif$costValuesAsMatrix(newvals))
+ };
+ }
+ coeff = rbind(mod(values[["net"]][["SumInsured"]][[type]]),
+ mod(values[["net"]][["Premium"]][[type]]),
+ mod(values[["Zillmer"]][["SumInsured"]][[type]]),
+ mod(values[["Zillmer"]][["Premium"]][[type]]),
+ mod(values[["gross"]][["SumInsured"]][[type]]),
+ mod(values[["gross"]][["Premium"]][[type]]));
+
+ writeData(wb, sheet, coeff, startCol = ccol+2, startRow = crow, colNames=FALSE, borders="rows", borderColour="gray5", borderStyle="thin");
+ dim(coeff)[[2]]
+}
+
+labelsReplace = function(labels) {
+ labels[labels=="alpha"] = "α";
+ labels[labels=="Zillmer"] = "Zill.";
+ labels[labels=="beta"] = "β";
+ labels[labels=="gamma"] = "γ";
+ labels[labels=="gamma_nopremiums"] = "γ_prf";
+ labels[labels=="SumInsured"] = "VS";
+ labels[labels=="SumPremiums"] = "PS";
+ labels[labels=="GrossPremium"] = "BP";
+
+ labels[labels=="premiums"] = "Präm.";
+ labels[labels=="guaranteed"] = "Gar.";
+ labels[labels=="survival"] = "Erl.";
+ labels[labels=="death_SumInsured"] = "Abl. VS";
+ labels[labels=="death_GrossPremium"] = "Abl. BP";
+ labels[labels=="death"] = "Abl.";
+ labels[labels=="death_PremiumFree"] = "Abl. prf";
+ labels[labels=="benefits"] = "Abl.Lst.";
+ labels[labels=="benefitsAndRefund"] = "Abl. + RG";
+
+ labels[labels=="once"] = "einm."
+ labels[labels=="PremiumPeriod"] = "PD"
+ labels[labels=="PremiumFree"] = "Pr.Fr."
+ labels[labels=="PolicyPeriod"] = "LZ"
+
+
+ labels
+}
+
+setInsuranceValuesLabels = function(vals) {
+ dimnames(vals) = lapply(dimnames(vals), labelsReplace);
+ vals
+}
+
+
+################################################################################
+#
+# The actual export function
+#
+# exportInsuranceContract.xlsx(contract, filename)
+#
+################################################################################
+
+
+exportInsuranceContract.xlsx = function(contract, filename) {
+ # TODO: argument checking for contract and filename
+
+ ###
+ nrrows = dim(contract$cashFlows)[[1]]; # Some vectors are longer (e.g. qx), so determine the max nr or rows
+ qp = contract$transitionProbabilities[1:nrrows,]; # extract the probabilities once, will be needed in every sheet
+
+ ################################################
+ # Style information
+ ################################################
+ styles = list(
+ header = createStyle(border="TopLeftRight", borderColour="#DA9694", borderStyle="medium",
+ bgFill="#C0504D", fontColour="#FFFFFF",
+ halign="center", valign="center", textDecoration="bold"),
+ tableHeader = createStyle(halign="center", valign="center", textDecoration="bold"),
+ hide0 = createStyle(numFmt="General; General; \"\""),
+ cost0 = createStyle(numFmt="0.000%; 0.000%; \"\""),
+ wrap = createStyle(wrapText=TRUE),
+ center = createStyle(halign="center", valign="center")
+ );
+
+ ################################################
+ # General Workbook setup
+ ################################################
+ wb = openxlsx::createWorkbook();
+ addWorksheet(wb, "Tarifinformationen");
+ addWorksheet(wb, "Reserven");
+ addWorksheet(wb, "abs.Barwerte");
+ addWorksheet(wb, "abs.Cash-Flows");
+ addWorksheet(wb, "Barwerte");
+ addWorksheet(wb, "Cash-Flows");
+
+ # Print out general Contract and Tariff information, including results
+ crow = 1;
+ writeData(wb, "Tarifinformationen", matrix(c(
+ "Tarif:", contract$tarif$tarif,
+ "Tarifname:", contract$tarif$name,
+ "Description:", contract$tarif$desc
+ ), 3, 2, byrow = TRUE), startCol=1, startRow=1, colNames=FALSE, rowNames=FALSE);
+ mergeCells(wb, "Tarifinformationen", cols=2:10, rows=1);
+ mergeCells(wb, "Tarifinformationen", cols=2:10, rows=2);
+ mergeCells(wb, "Tarifinformationen", cols=2:10, rows=3);
+ addStyle(wb, "Tarifinformationen", style=styles$wrap, rows=3, cols=2:10, stack=TRUE);
+ addStyle(wb, "Tarifinformationen", style=createStyle(valign="top"), rows=1:3, cols=1:10, gridExpand=TRUE, stack=TRUE);
+
+ crow = crow+4;
+
+ ################################################
+ # Basic parameters
+ ################################################
+ sheet = "Tarifinformationen"
+ values=c(
+ "Sum insured"=contract$params$sumInsured,
+ "Mortality table"=contract$tarif$mortalityTable@name,
+ "YOB"=contract$params$YOB,
+ "Age"=contract$params$age,
+ "Policy duration"=contract$params$policyPeriod,
+ "Premium period"=contract$params$premiumPeriod,
+ "Deferral"=contract$params$deferral,
+ "Guaranteed payments"=contract$params$guaranteed,
+ i=contract$tarif$i);
+
+ writeData(wb, sheet, "Basisdaten des Vertrags und Tarifs", startCol=1, startRow=crow);
+ mergeCells(wb, sheet, cols=1:length(values), rows=crow:crow);
+ writeDataTable(wb, sheet, as.data.frame(t(values)),
+ startCol=1, startRow=crow+1, colNames=TRUE, rowNames=FALSE,
+ tableStyle="TableStyleMedium3", withFilter = FALSE, headerStyle = styles$tableHeader);
+ crow = crow + 4;
+
+ # Premiums
+ writeData(wb, sheet, "Prämien", startCol=1, startRow=crow);
+ mergeCells(wb, sheet, cols=1:length(contract$premiums), rows=crow:crow);
+ writeDataTable(wb, sheet, setInsuranceValuesLabels(as.data.frame(t(contract$premiums))),
+ startCol=1, startRow=crow+1, colNames=TRUE, rowNames=FALSE,
+ tableStyle="TableStyleMedium3", withFilter = FALSE, headerStyle = styles$tableHeader);
+ crow = crow + 4;
+
+ # Cost structure:
+ costtable = as.data.frame.table(setInsuranceValuesLabels(contract$tarif$costs), responseName = "Kostensatz", dnn = c("Kostenart", "Basis", "Periode"), exclude=c(0))
+ costtable = costtable[costtable[,"Kostensatz"]!=0.0000,]
+ writeData(wb, sheet, costtable, startCol=1, startRow=crow+1, colNames=FALSE, rowNames=FALSE,borders = "surrounding", borderColour = "red", borderStyle = "medium")
+
+ ################################################
+ # Print out Reserves and premium decomposition
+ ################################################
+
+ # Age, death and survival probabilities
+ ccol = 1;
+ crow = 4;
+ sheet = "Reserven";
+
+ ccol = ccol + writeAgeQTable(wb, sheet, probs=qp, crow=crow, ccol=1, styles=styles);
+ ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(setInsuranceValuesLabels(contract$reserves)),
+ crow=crow, ccol=ccol, tableName="Reserves",
+ caption="Reserven", valueStyle=styles$hide0) + 1;
+ ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(setInsuranceValuesLabels(contract$premiumComposition)),
+ crow=crow, ccol=ccol, tableName="Premium_Decomposition",
+ caption = "Prämienzerlegung", valueStyle=styles$hide0) + 1;
+
+
+ ################################################
+ # Print out absolute values of present values
+ ################################################
+
+ # Age, death and survival probabilities
+ ccol = 1;
+ crow = 4;
+ sheet = "abs.Barwerte";
+ ccol = ccol + writeAgeQTable(wb, sheet, probs=qp, crow=crow, ccol=1, styles=styles);
+
+ ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(setInsuranceValuesLabels(contract$absPresentValues)),
+ crow=crow, ccol=ccol, tableName="PresentValues_absolute",
+ caption = "abs. Leistungs- und Kostenbarwerte", valueStyle=styles$hide0) + 1;
+
+
+ ################################################
+ # Print out absolute values for cash flows
+ ################################################
+
+ # Age, death and survival probabilities
+ ccol = 1;
+ crow = 4;
+ sheet = "abs.Cash-Flows";
+ ccol = ccol + writeAgeQTable(wb, sheet, probs=qp, crow=crow, ccol=1, styles=styles);
+ ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(setInsuranceValuesLabels(contract$absCashFlows)),
+ crow=crow, ccol=ccol, tableName="CashFlows_absolute",
+ caption="abs. Leistungs- und Kostencashflows", withFilter=TRUE, valueStyle=styles$hide0) + 1;
+
+
+ ################################################
+ # Print out present values
+ ################################################
+
+ # Age, death and survival probabilities
+ costPV = as.data.frame(contract$tarif$costValuesAsMatrix(setInsuranceValuesLabels(contract$presentValuesCosts)));
+ ccol = 1;
+ crow = 4;
+ sheet = "Barwerte";
+ # 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);
+
+ # Store the start/end columns of the coefficients, since we need them later in the formula for the premiums!
+ w1 = writePremiumCoefficients(wb, sheet, contract$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);
+ ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(setInsuranceValuesLabels(contract$presentValues)),
+ crow=crow+6, ccol=ccol, tableName="PresentValues_Benefits",
+ caption = "Leistungsbarwerte", valueStyle=styles$hide0) + 1;
+
+ w2 = writePremiumCoefficients(wb, sheet, contract$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);
+ ccol = ccol + writeValuesTable(wb, sheet, as.data.frame(costPV),
+ crow=crow+6, ccol=ccol, tableName="PresentValues_Costs",
+ caption = "Kostenbarwerte", valueStyle=styles$cost0) + 1;
+
+ # Now print out the formulas for premium calculation into the columns 2 and 3:
+ writeData(wb, sheet, as.data.frame(c("Nettoprämie", contract$premiums[["net"]],"Zillmerprämie", contract$premiums[["Zillmer"]], "Bruttoprämie", contract$premiums[["gross"]])), startCol = 1, startRow=crow, colNames = FALSE, borders = "rows");
+ for (i in 0:5) {
+ writeFormula(wb, sheet, paste0("SUMPRODUCT(", sprintf(area.premiumcoeff, crow+i, crow+i), ", ", area.premiumvals, ") + SUMPRODUCT(", sprintf(area.costcoeff, crow+i, crow+i), ", ", area.costvals, ")"), startCol = 3, startRow = crow+i);
+ }
+ for (i in c(0,2,4)) {
+ writeFormula(wb, sheet, paste0(int2col(3), crow+i, "/", int2col(3), crow+i+1), startCol=2, startRow = crow+i);
+ }
+ for (i in c(1,3,5)) {
+ writeFormula(wb, sheet, paste0(int2col(2), crow+i-1, "*", contract$params$sumInsured), startCol=2, startRow = crow+i);
+ }
+
+
+ ################################################
+ # Print out cash flows
+ ################################################
+
+ # Age, death and survival probabilities
+ costCF = as.data.frame(contract$tarif$costValuesAsMatrix(setInsuranceValuesLabels(contract$cashFlowsCosts)));
+ ccol = 1;
+ crow = 4;
+ sheet = "Cash-Flows";
+ ccol = ccol + writeAgeQTable(wb, sheet, probs=qp, crow=crow, ccol=1, styles=styles);
+ ccol = ccol + writeValuesTable(wb, sheet, setInsuranceValuesLabels(contract$cashFlows),
+ crow=crow, ccol=ccol, tableName="CashFlows_Benefits",
+ caption="Leistungscashflows", withFilter=TRUE, valueStyle=styles$hide0) + 1;
+ ccol = ccol + writeValuesTable(wb, sheet, costCF,
+ crow=crow, ccol=ccol, tableName="CashFlows_Costs",
+ caption="Kostencashflows", withFilter=TRUE, valueStyle=styles$cost0) + 1;
+
+
+ openxlsx::saveWorkbook(wb, filename, overwrite = TRUE)
+
+
+ # #### Contract
+ # premiumPayments = PaymentTimeEnum("in advance"),
+ # benefitPayments = PaymentTimeEnum("in advance"),
+ # premiumFrequency = 1,
+ # benefitFrequency = 1, # Only for annuities!
+ # loadings = list(), # Allow overriding the tariff-defined loadings (see the InsuranceTariff class for all possible names)
+ # premiumSum = 0,
+ #
+ #
+ # #### TARIF:
+ # tariffType = TariffTypeEnum("wholelife"), # possible values: annuity, wholelife, endowment, pureendowment, terme-fix
+ # premiumFrequencyOrder = 0,
+ # benefitFrequencyOrder = 0,
+ # widowFactor = 0,
+ # premiumRefund = 0,
+ # premiumRefundLoading = 0, # Mindesttodesfallrisiko soll damit erreicht werden, z.B. 105% der einbezahlten Prämien
+ # costs = list(),
+ # benefitFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Properly implement this
+ # premiumFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Implement this
+ # loadings = list( # Loadings can also be function(sumInsured, premiums) # TODO: Add other possible arguments
+ # "ongoingAlphaGrossPremium" = 0, # Acquisition cost that increase the gross premium
+ # "tax" = 0.04, # insurance tax, factor on each premium paid
+ # "unitcosts" = 0, # annual unit cost for each policy (Stückkosten), absolute value
+ # "security" = 0, # Additional security loading on all benefit payments, factor on all benefits
+ # "noMedicalExam" = 0, # Loading when no medicial exam is done, % of SumInsured
+ # "noMedicalExamRelative" = 0, # Loading when no medicial exam is done, % of gross premium
+ # "sumRebate" = 0, # gross premium reduction for large premiums, % of SumInsured
+ # "premiumRebate" = 0, # gross premium reduction for large premiums, % of gross premium # TODO
+ # "advanceProfitParticipation" = 0, # Vorweggewinnbeteiligung (%-Satz der Bruttoprämie)
+ # "advanceProfitParticipationInclUnitCost" = 0, # Vorweggewinnbeteiligung (%-Satz der Prämie mit Zu-/Abschlägen, insbesondere nach Stückkosten)
+ # "partnerRebate" = 0 # Partnerrabatt auf Prämie mit Zu-/Abschlägen, wenn mehr als 1 Vertrag gleichzeitig abgeschlossen wird, additiv mit advanceBonusInclUnitCost and premiumRebate
+ # ),
+
+}