diff --git a/Formulas_Reference/.gitignore b/Formulas_Reference/.gitignore
index 57c51da76456a015a5fd12ae5e07414e86019849..5a1c25fd024551483b808dbf4e0b36a328951687 100644
--- a/Formulas_Reference/.gitignore
+++ b/Formulas_Reference/.gitignore
@@ -4,3 +4,4 @@
*.synctex.gz
*.backup
*.kilepr
+Bernkopf Max
diff --git a/R/HelperFunctions.R b/R/HelperFunctions.R
index 7ebdffd7688e54903311449862a0d414aacacab5..be97ab16c1aaec86b19f08f2cc0d9e504c4c1074 100644
--- a/R/HelperFunctions.R
+++ b/R/HelperFunctions.R
@@ -56,11 +56,13 @@ calculatePVDeath = function(q, benefits, ..., v=1) {
}
-correctionPaymentsPerYear = function(m = 1, i = self$i, order = 0) {
+correctionPaymentFrequency = function(m = 1, i = self$i, order = 0) {
# 0th-order approximation
alpha=1;
- beta=(m-1)/(2*m);
-
+ beta=0;
+ # negative orders mean that NO correction is done, e.g. because other means of
+ # correction are used like an explicit premium frequency loading on the premium.
+ if (order >=0 ) beta = beta + (m-1)/(2*m);
# For higher orders, simply add one term after the other!
if (order >= 1) beta = beta + (m^2-1)/(6*m^2)*i;
# order 1.5 has a special term that should NOT be used for higher-order approximations!
@@ -90,3 +92,10 @@ pad0 = function(v, l, value=0) {
}
}
+valueOrFunction = function(val, ...) {
+ if (is.function(val)) {
+ val(...)
+ } else {
+ val
+ }
+}
diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R
index a2112230b56fc6f95a88ce578ab04fb41f548ae9..1ff3bfca125bbd781cf870cd69f3d0cca266eb2f 100644
--- a/R/InsuranceTarif.R
+++ b/R/InsuranceTarif.R
@@ -1,4 +1,4 @@
-library(R6);
+library(R6)
library(lifecontingencies)
library(objectProperties)
library(foreach)
@@ -42,27 +42,39 @@ InsuranceTarif = R6Class(
i = 0, # guaranteed interest rate
v = 1, # discount factor
tariffType = TariffTypeEnum("wholelife"), # possible values: annuity, wholelife, endowment, pureendowment
- benefitPaymentsPerYearOrder = 0,
+ premiumFrequencyOrder = 0,
+ benefitFrequencyOrder = 0,
widowFactor = 0,
premiumRefund = 0,
- premiumRefundSpread = 0,
+ premiumRefundLoading = 0, # Mindesttodesfallrisiko soll damit erreicht werden, z.B. 105% der einbezahlten Prämien
advanceBonus = 0,
sumRebate = 0,
costs = list(),
- paymentsPerYearSurcharge = list("1" = 0.0, "2" = 0.01, "4" = 0.015, "12" = 0.02),
- surcharges = list("tax" = 0.04, "unitcosts" = 0, "security" = 0, "noMedicalExam" = 0),
-
-
- initialize = function(name = NA, mortalityTable = NA, i = NA, type = "wholelife", ..., paymentsPerYearOrder = 0, costs) {
+ benefitFrequencyLoading = list("1" = 0.0, "2" = 0.01, "4" = 0.015, "12" = 0.02), # TODO: Properly implement this
+ premiumFrequencyLoading = list("1" = 0.0, "2" = 0.01, "4" = 0.015, "12" = 0.02), # TODO: Implement this
+ loadings = list( # Loadings can also be function(sumInsured, premiums) # TODO: Add other possible arguments
+ "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
+ "sumRebate" = 0, # gross premium reduction for large premiums, % of SumInsured
+ "premiumRebate" = 0, # gross premium reduction for large premiums, % of gross premium # TODO
+ "advanceProfitParticipation" = 0, # Profit participation in advance, % of the premium
+ "ongoingAlphaGrossPremium" = 0 # Acquisition cost that increase the gross premium
+ ),
+
+
+ initialize = function(name = NA, mortalityTable = NA, i = NA, type = "wholelife", ..., premiumFrequencyOrder = 0, benefitFrequencyOrder = 0, costs) {
if (!missing(name)) self$name = name;
if (!missing(mortalityTable)) self$mortalityTable = mortalityTable;
if (!missing(i)) self$i = i;
if (!missing(type)) self$tariffType = type;
self$costs = if (!missing(costs)) costs else initializeCosts();
- if (!missing(paymentsPerYearOrder)) self$paymentsPerYearOrder = paymentsPerYearOrder;
+ if (!missing(benefitFrequencyOrder)) self$benefitFrequencyOrder = benefitFrequencyOrder;
+ if (!missing(premiumFrequencyOrder)) self$premiumFrequencyOrder = premiumFrequencyOrder;
self$v = 1/(1+self$i);
@@ -174,8 +186,10 @@ InsuranceTarif = R6Class(
for (i in 1:premiumPeriod) {
cf[i,,] = cf[i,,] + self$costs[,,"PremiumPeriod"];
}
- for (i in (premiumPeriod+1):policyPeriod) {
- cf[i,,] = cf[i,,] + self$costs[,,"PremiumFree"];
+ if (premiumPeriod<policyPeriod) {
+ for (i in (premiumPeriod+1):policyPeriod) {
+ cf[i,,] = cf[i,,] + self$costs[,,"PremiumFree"];
+ }
}
for (i in 1:policyPeriod) {
cf[i,,] = cf[i,,] + self$costs[,,"PolicyPeriod"];
@@ -183,18 +197,19 @@ InsuranceTarif = R6Class(
cf
},
- presentValueCashFlows = function(cashflows, age, ..., benefitPaymentsPerYear = 1, maxAge = getOmega(self$mortalityTable)) {
+ presentValueCashFlows = function(cashflows, age, ..., premiumFrequency = 1, benefitFrequency = 1, maxAge = getOmega(self$mortalityTable)) {
len = length(cashflows$premiums_advance);
qq = self$getTransitionProbabilities (age, ...);
q = pad0(qq$q, len);
ages = pad0(qq$age, len);
- correctionPaymentsPerYear = correctionPaymentsPerYear(m = benefitPaymentsPerYear, i = self$i, order = self$benefitPaymentsPerYearOrder);
+ 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(
+ pv = as.matrix(data.frame( # TODO: Find a better way to combine the vectors into a matrix with given row/column names!
age = ages,
- premiums = calculatePVSurvival (q, cashflows$premiums_advance, cashflows$premiums_arrears, v=self$v),
- guaranteed = calculatePVSurvival (q*0, cashflows$guaranteed_advance, cashflows$guaranteed_arrears, m=benefitPaymentsPerYear, mCorrection=correctionPaymentsPerYear, v=self$v),
- survival = calculatePVSurvival (q, cashflows$survival_advance, cashflows$survival_arrears, m=benefitPaymentsPerYear, mCorrection=correctionPaymentsPerYear, v=self$v),
+ 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),
@@ -215,9 +230,9 @@ InsuranceTarif = R6Class(
getPremiumCoefficients = function(type="gross", coeffBenefits, coeffCosts, ...,
premiumSum = 0,
- premiums = list("gross"=0,"net"=0, "Zillmer"=0)) {
- securityLoading = self$surcharges$security;
- refundAddon = self$premiumRefundSpread;
+ premiums = c("unit.gross"=0)) {
+ securityLoading = self$loadings$security;
+ refundAddon = self$premiumRefundLoading;
coefficients = list(
"SumInsured" = list("benefits" = coeffBenefits*0, "costs" = coeffCosts*0),
@@ -233,7 +248,7 @@ InsuranceTarif = R6Class(
if (type == "gross") {
coefficients[["Premium"]][["benefits"]][["death_GrossPremium"]] = -(1+refundAddon) * (1+securityLoading);
} else if (type=="net" || type=="Zillmer") {
- coefficients[["SumInsured"]][["benefits"]][["death_GrossPremium"]] = premiums$gross * (1+refundAddon) * (1+securityLoading);
+ coefficients[["SumInsured"]][["benefits"]][["death_GrossPremium"]] = premiums[["unit.gross"]] * (1+refundAddon) * (1+securityLoading);
}
@@ -257,36 +272,56 @@ InsuranceTarif = R6Class(
coefficients[["SumInsured"]][["costs"]]["beta", "SumInsured"] = 1;
coefficients[["SumInsured"]][["costs"]]["gamma", "SumInsured"] = 1;
- coefficients[["SumInsured"]][["costs"]]["Zillmer","SumPremiums"] = premiumSum * premiums$gross;
- coefficients[["SumInsured"]][["costs"]]["beta", "SumPremiums"] = premiumSum * premiums$gross;
- coefficients[["SumInsured"]][["costs"]]["gamma", "SumPremiums"] = premiumSum * premiums$gross;
+ coefficients[["SumInsured"]][["costs"]]["Zillmer","SumPremiums"] = premiumSum * premiums[["unit.gross"]];
+ coefficients[["SumInsured"]][["costs"]]["beta", "SumPremiums"] = premiumSum * premiums[["unit.gross"]];
+ coefficients[["SumInsured"]][["costs"]]["gamma", "SumPremiums"] = premiumSum * premiums[["unit.gross"]];
- coefficients[["SumInsured"]][["costs"]]["Zillmer","GrossPremium"] = premiums$gross;
- coefficients[["SumInsured"]][["costs"]]["beta", "GrossPremium"] = premiums$gross;
- coefficients[["SumInsured"]][["costs"]]["gamma", "GrossPremium"] = premiums$gross;
+ coefficients[["SumInsured"]][["costs"]]["Zillmer","GrossPremium"] = premiums[["unit.gross"]];
+ coefficients[["SumInsured"]][["costs"]]["beta", "GrossPremium"] = premiums[["unit.gross"]];
+ coefficients[["SumInsured"]][["costs"]]["gamma", "GrossPremium"] = premiums[["unit.gross"]];
}
coefficients
- }
- ,
+ },
- premiumCalculation = function(pvBenefits, pvCosts, costs=self$costs, premiumSum=0) {
- premiums = c("net" = 0, "gross"= 0, "Zillmer" = 0);
+ premiumCalculation = function(pvBenefits, pvCosts, costs=self$costs, premiumSum=0, sumInsured=1, premiumFrequency = 1) {
+ premiums = c("unit.net" = 0, "unit.gross"= 0, "unit.Zillmer" = 0, "net" = 0, "gross" = 0, "Zillmer" = 0, "written" = 0);
+ # 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", pvBenefits["0",]*0, pvCosts["0",,]*0, premiums=premiums, premiumSum=premiumSum)
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["SumInsured"]][["costs"]] * pvCosts["0",,]);
denominator = sum(coeff[["Premium" ]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["Premium" ]][["costs"]] * pvCosts["0",,]);
- premiums[["gross"]] = enumerator/denominator;
+ ongoingAlphaGrossPremium = self$loadings$ongoingAlphaGrossPremium;
+ premiums[["unit.gross"]] = enumerator/denominator * (1 + ongoingAlphaGrossPremium);
+ premiums[["gross"]] = premiums[["unit.gross"]] * sumInsured;
coeff=self$getPremiumCoefficients("net", pvBenefits["0",]*0, pvCosts["0",,]*0, premiums=premiums, premiumSum=premiumSum)
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["SumInsured"]][["costs"]] * pvCosts["0",,]);
denominator = sum(coeff[["Premium" ]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["Premium" ]][["costs"]] * pvCosts["0",,]);
- premiums[["net"]] = enumerator/denominator; premiums
+ premiums[["unit.net"]] = enumerator/denominator; premiums
+ premiums[["net"]] = premiums[["unit.net"]] * sumInsured;
coeff=self$getPremiumCoefficients("Zillmer", pvBenefits["0",]*0, pvCosts["0",,]*0, premiums=premiums, premiumSum=premiumSum)
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["SumInsured"]][["costs"]] * pvCosts["0",,]);
denominator = sum(coeff[["Premium" ]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["Premium" ]][["costs"]] * pvCosts["0",,]);
- premiums[["Zillmer"]] = enumerator/denominator;
+ premiums[["unit.Zillmer"]] = enumerator/denominator;
+ premiums[["Zillmer"]] = premiums[["unit.Zillmer"]] * sumInsured;
+
+ # The written premium is the gross premium with additional loadings, rebates, unit costs and taxes
+ tax = valueOrFunction(self$loadings$tax, sumInsured=sumInsured, premiums=premiums);
+ unitCosts = valueOrFunction(self$loadings$unitcosts, sumInsured=sumInsured, premiums=premiums);
+ noMedicalExam = valueOrFunction(self$loadings$noMedicalExam,sumInsured=sumInsured, premiums=premiums);
+ sumRebate = valueOrFunction(self$loadings$sumRebate, sumInsured=sumInsured, premiums=premiums);
+ premiumRebate = valueOrFunction(self$loadings$premiumRebate,sumInsured=sumInsured, premiums=premiums); # TODO: How shall this be included in the premium calculation?
+ advanceProfitParticipation = valueOrFunction(self$loadings$advanceProfitParticipation,sumInsured=sumInsured, premiums=premiums);
+
+ frequencyLoading = valueOrFunction(self$premiumFrequencyLoading, sumInsured=sumInsured, premiums=premiums);
+
+ premiumBeforeTax = (premiums[["unit.gross"]] + noMedicalExam - sumRebate)*sumInsured * (1-advanceProfitParticipation) + unitCosts;
+ premiumBeforeTax = premiumBeforeTax * (1+frequencyLoading[[toString(premiumFrequency)]]) / premiumFrequency;
+ premiums[["written_beforetax"]] = premiumBeforeTax;
+ premiums[["tax"]] = premiumBeforeTax * tax;
+ premiums[["written"]] = premiumBeforeTax * (1 + tax);
premiums
},
@@ -298,6 +333,7 @@ InsuranceTarif = R6Class(
)
);
+
costs = initializeCosts();
# costs["alpha", "SumInsured",] = c(1,2,5);
# costs["beta", "SumPremiums",] = c(3,2,1);
@@ -327,7 +363,12 @@ cfc = TestTarif$getCashFlowsCosts(YOB = 1980, age = 30, premiumPaymentPeriod = 5
pv = TestTarif$presentValueCashFlows(cf, age = 30, YOB=1980); pv
pvc = TestTarif$presentValueCashFlowsCosts(cfc, age=30, YOB=1980); pvc
-premiums=TestTarif$premiumCalculation(pv, pvc, premiumSum=15); as.array(premiums)*1000
+premiums=TestTarif$premiumCalculation(pv, pvc, premiumSum=15); premiums
+
+
+
+premiums*1000
+as.array(premiums)*1000
c("net"=1, "gross"=23, "Zillmer"=44)
str(as.matrix( premiums))
@@ -350,193 +391,81 @@ InsuranceContract = R6Class(
"InsuranceContract",
public = list(
tarif = NA,
+
+ #### Contract settings
+ sumInsured = 1,
YOB = NA,
age = NA,
policyPeriod = Inf,
- premiumPaymentPeriod = 1,
+ premiumPeriod = 1,
deferral = 0,
guaranteed = 0,
premiumPayments = PaymentTimeEnum("in advance"),
benefitPayments = PaymentTimeEnum("in advance"),
- premiumPaymentsPerYear = 1,
- benefitPaymentsPerYear = 1, # Only for annuities!
-
+ premiumFrequency = 1,
+ benefitFrequency = 1, # Only for annuities!
+ #### Caching values for this contract, initialized/calculated when the object is created
transitionProbabilities = NA,
+
+ cashFlowsBasic = NA,
cashFlows = NA,
- # cashFlowsState = list(c(0), c(0)),
- # cashFlowsTransition = list(matrix(c(0,1,0,1), 2, 2, byrow=TRUE)),
-
- initialize = function(tarif, age, policyPeriod = inf, ..., deferral = 0, YOB = 1975) {
- if (!missing(tarif)) self$tarif = tarif;
- if (!missing(age)) self$age = age;
- if (!missing(YOB)) self$YOB = YOB;
- if (!missing(deferral)) self$deferral = deferral;
- if (!missing(policyPeriod)) self$policyPeriod = policyPeriod;
+ cashFlowsCosts = NA,
+ premiumSum = 0,
+
+ presentValues = NA,
+ presentValuesCosts = NA,
+
+ premiums = NA,
+
+
+ #### The code:
+
+ initialize = function(tarif, age, policyPeriod, premiumPeriod = policyPeriod, sumInsured = 1, ..., deferral = 0, YOB = 1975) {
+ self$tarif = tarif;
+ self$age = age;
+ self$policyPeriod = policyPeriod;
+ self$premiumPeriod = premiumPeriod;
+ self$sumInsured = sumInsured;
+ if (!missing(deferral)) self$deferral = deferral;
+ if (!missing(YOB)) self$YOB = YOB;
+
self$determineTransitionProbabilities();
self$determineCashFlows();
+ self$calculatePresentValues();
+ self$calculatePremiums();
},
determineTransitionProbabilities = function() {
- self$transitionProbabilities = self$tarif$getTransitionProbabilities(self$age, self$YOB);
+ self$transitionProbabilities = self$tarif$getTransitionProbabilities(YOB = self$YOB, age = self$age);
+ self$transitionProbabilities
},
determineCashFlows = function() {
- self$cashFlowsState = self$tarif$getCashFlowsState(age = self$age, YOB = self$YOB, policyPeriod = self$policyPeriod, deferral = self$deferral, maxAge = self$age + length(self$transitionProbabilities));
- self$cashFlowsTransition = self$tarif$getCashFlowsState(age = self$age, YOB = self$YOB, policyPeriod = self$policyPeriod, deferral = self$deferral, maxAge = self$age + length(self$transitionProbabilities));
-
- }
-
+ self$cashFlowsBasic = self$tarif$getBasicCashFlows(YOB = self$YOB, age = self$age, policyPeriod = self$policyPeriod, premiumPeriod = self$premiumPeriod);
+ self$cashFlows = self$tarif$getCashFlows(age = self$age, premiumPayments = self$premiumPayments, policyPeriod = self$policyPeriod, premiumPaymentPeriod = self$premiumPeriod, 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, premiumPaymentPeriod = self$premiumPeriod, policyPeriod = self$policyPeriod);
+ 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);
+ self$presentValuesCosts = self$tarif$presentValueCashFlowsCosts(self$cashFlowsCosts, age = self$age, YOB = self$YOB);
+ list("benefits" = self$presentValues, "costs" = self$presentValuesCosts)
+ },
+ calculatePremiums = function() {
+ self$premiums = self$tarif$premiumCalculation(self$presentValues, self$presentValuesCosts, premiumSum = self$premiumSum, sumInsured = self$sumInsured);
+ self$premiums
+ },
+ dummy=NA
)
);
-setGeneric("setYOB", function(scale, ...) standardGeneric("setYOB"));
-setMethod("setYOB", "InsuranceScale",
- function (scale, ..., YOB=1975) {
- scale@YOB=YOB;
- scale
- }
-)
-
-setGeneric("getTransitionProbabilities", function(scale, ...) standardGeneric("getTransitionProbabilities"));
-setMethod("getTransitionProbabilities", "InsuranceScale",
- function (scale, ...) {
- q = deathProbabilities(scale@mortalityTable, scale@YOB);
- p = 1-q;
- len = length(p);
- df=data.frame(p, q, rep(0,len), rep(1,len), row.names=ages(scale@mortalityTable, scale@YOB))
- }
-)
-
-
-setGeneric("calculateTransitionProbabilities", function(scale, ...) standardGeneric("calculateTransitionProbabilities"));
-setMethod("calculateTransitionProbabilities", "InsuranceScale",
- function (scale, ...) {
- scale@transitionProbabilities = getTransitionProbabilities(scale, ...);
- scale
- }
-)
-
-TestTarif = InsuranceScale(name="Testtarif", YOB=1980, age=30)
-#TestTarif = setYOB(TestTarif, YOB=1980)
-
-getTransitionProbabilities(TestTarif)
-
-t=AVOe2005R.unisex
-t@ages
-t@deathProbs
-qqq
-qqq["1",]
-
-mort=deathProbabilities(AVOe2005R.male, YOB=1977); mort
-
-mort=deathProbabilities(AVOe2005R.unisex, YOB=1977); mort
-q=mort
-p=1-mort; p
-len=length(p); len
-qqq=data.frame(q=t@deathProbs, row.names=t@ages); qqq
-
-df=data.frame("A-A"=p, "A-t"=q, "t-A"=rep(0, len), "t-t"=rep(1, len), row.names=t@ages)
-df
-
-
-
-# createCostStructure=function(age=35,contractLength=inf,
-# alphaVS,
-# alphaBP,
-#
-#
-# CostStructure=setClass(
-# "CostStructure",
-#
-# )
-
-
-calcUnterjährigkeit = function(m=1,i=0, order=0) {
- alpha=1;
- beta=(m-1)/(2*m);
- if (order>=1) { beta = beta + (m^2-1)/(6*m^2)*i; }
- if (order == 1.5) { beta = beta + (1-m^2)/(12*m^2)*i^2; }
- if (order >= 2) { beta = beta + (1-m^2)/(24*m^2)*i^2;
- alpha= alpha+ (m^2-1)/(12*m^2)*i^2; }
- list(alpha=alpha, beta=beta);
-}
-
-setGeneric("createContractCashflows", function(object) standardGeneric("createContractCashflows"))
-
-setGeneric("calculate", function(object) standardGeneric("calculate"));
-setMethod("calculate", "InsuranceContract",
- function (object) {
- # 0) Prepare helper values
- # 0a: Unterjährigkeit
- m = object@unterjährigkeit;
- object@cache.uj=calcUnterjährigkeit(m=m, i=object@interest, order=object@unterjährigkeitsapproximation);
-
-
- # 1) Generate mortality table
- if (!is.null(object@contractLength) && is.finite(object@contractLength)) {
- ages = (object@age):(object@contractLength);
- } else {
- ages = (object@age):150;
- }
- qx = deathProbabilities(object@mortalityTable, YOB=object@YOB)[ages+1];
- pxn = cumprod(1-qx);
- object@probabilities = data.frame(ages=ages,qx=qx, pxn=pxn)
- if (!is.null(object@YOB2)) {
- ages2 = ages - object@age + object@age2;
- qx2 = deathProbabilities(object@mortalityTable2, YOB=object@YOB2)[ages2+1];
- pxn2 = cumprod(1-qx2);
- pxyn = pxn * pxn2;
- object@probabilities = data.frame(object@probabilities, ages2=ages2, q2=qx2, pxn2=pxn2, pxyn=pxyn);
- }
-
-
- # 2) Properly set up the payment and cost cash flow data frames
- # 3) Calculate all NPVs of the payment and the cost cash flows (recursively)
- # 3a: life-long annuities for person 2 (and person 1+2), in case the death benefit is a life-long widow's annuity
- # 4) Set up the coefficients of the NPVs for the premium calculation
- # 5) Calculate the gross premium
- # 6) Calculate the net premium and the Zillmer premium
-
- # 7) Calculate all reserves (benefits and costs)
-
- # 8) Calculate Spar- und Risikoprämie from the net premium and the reserves
-
- # 9) Calculate VS after Prämienfreistellung
- # 9a: Calculate all reserves after Prämienfreistellung
-
- # 10) Calculate the Bilanz reserves
-
- # 11) Calculate the Rückkaufswert
- # max(object@ages,na.rm=TRUE);
- object
- })
-
-
-beispielvertrag = InsuranceContract(
- name="Beispielvertrag", tarif="Beispieltarif",
- desc="Beispiel zum Testen des Codes",
- YOB=1948, YOB2=1948+65-62,
- age=65, age2=62,
- # contractLength=30,
- mortalityTable=AVOe2005R.unisex, mortalityTable2=AVOe2005R.unisex,
- interest=0.0125,
-
- unterjährigkeit=12, unterjährigkeitsapproximation=1.5,
-
- # deathPayments=list(),
- # survivalPayments=list(),
- # costCashflows=data.frame(),
- # cashflows=data.frame()
-);
-beispielvertrag=calculate(beispielvertrag)
-beispielvertrag
-# data.frame(x=0:121, qx=deathProbabilities(AVOe2005R.unisex, YOB=1948))
diff --git a/R/ValuationTables.R b/R/ValuationTables.R
index fec78749592d004b45b4ccfa57957a93b78c222e..bd77f3eda939373edb8dc68b9ea0d8f688598d32 100644
--- a/R/ValuationTables.R
+++ b/R/ValuationTables.R
@@ -3,26 +3,26 @@ library(ggplot2);
# (virtual) base class for valuation tables, contains only the name / ID
valuationTable=setClass(
- "valuationTable",
- slots=list(name="character", baseYear="numeric"),
- prototype=list(name="Actuarial Valuation Table", baseYear=2000),
+ "valuationTable",
+ slots=list(name="character", baseYear="numeric"),
+ prototype=list(name="Actuarial Valuation Table", baseYear=2000),
contains="VIRTUAL"
);
-# A period life table, giving death probabilities for each age, up to
+# A period life table, giving death probabilities for each age, up to
# maximum age omega. Optionally apply selection factors to the probabilities
valuationTable.period=setClass(
- "valuationTable.period",
+ "valuationTable.period",
slots=list(ages="numeric", deathProbs="numeric"),
prototype=list(ages=eval(0:120), deathProbs=rep(1,120)),
contains="valuationTable"
);
-# A cohort life table, obtained by age-shifting from a given base table (PODs
+# A cohort life table, obtained by age-shifting from a given base table (PODs
# for a base YOB)
valuationTable.ageShift=setClass(
- "valuationTable.ageShift",
+ "valuationTable.ageShift",
slots=list(ageShifts="data.frame"),
prototype=list(ageShifts=data.frame(YOB=c(), shifts=c())),
contains="valuationTable.period"
@@ -34,25 +34,25 @@ valuationTable.ageShift=setClass(
# The dampingFunction can be used to modify the cumulative years (e.g. G(tau+x) instead of tau+x)
# If trend2 is given, the G(tau+x) gives the weight of the first trend, 1-G(tau+x) the weight of the second trend
valuationTable.trendProjection=setClass(
- "valuationTable.trendProjection",
+ "valuationTable.trendProjection",
slots=list(baseYear="numeric", trend="numeric", dampingFunction="function", trend2="numeric"),
prototype=list(baseYear=1980, trend=rep(0,120), dampingFunction=identity, trend2=0),
contains="valuationTable.period"
);
-# A cohort life table, obtained by an improvment factor projection
+# A cohort life table, obtained by an improvment factor projection
# from a given base table (PODs for a given observation year).
valuationTable.improvementFactors=setClass(
- "valuationTable.improvementFactors",
+ "valuationTable.improvementFactors",
slots=list(baseYear="numeric", improvement="numeric"),
prototype=list(baseYear=2012, improvement=rep(0,120)),
contains="valuationTable.period"
);
-# A cohort life table described by actual observations (data frame of PODs
+# A cohort life table described by actual observations (data frame of PODs
# per year and age)
valuationTable.observed=setClass(
- "valuationTable.observed",
+ "valuationTable.observed",
slots=list(data="data.frame"),
prototype=list(data=data.frame()),
contains="valuationTable"
@@ -62,15 +62,15 @@ valuationTable.observed=setClass(
# applies only to certain observation years (e.g. for the past use the observed
# PODs, and project them to the future with the trend projection)
valuationTable.joined=setClass(
- "valuationTable.joined",
+ "valuationTable.joined",
slots=list(
- table1="valuationTable", yearRange1="numeric",
+ table1="valuationTable", yearRange1="numeric",
table2="valuationTable", yearRange2="numeric"),
contains="valuationTable"
);
# A cohort life table obtained by mixing two life tables with the given weights
valuationTable.mixed=setClass(
- "valuationTable.mixed",
+ "valuationTable.mixed",
slots=c(table1="valuationTable", table2="valuationTable", weight1="numeric", weight2="numeric"),
prototype=list(weight1=1/2, weight2=1/2),
contains="valuationTable"
@@ -212,9 +212,9 @@ setGeneric("getPeriodTable", function(object, Period, ...) standardGeneric("getP
setMethod("getPeriodTable","valuationTable",
function (object, Period, ...) {
valuationTable.period(
- name = paste(object@name, ", Period ", Period),
+ name = paste(object@name, ", Period ", Period),
baseYear = Period,
- ages = ages(object),
+ ages = ages(object),
deathProbs = periodDeathProbabilities(object, Period=Period)
)
})
@@ -225,12 +225,19 @@ setMethod("getCohortTable","valuationTable",
valuationTable.period(
name = paste(object@name, ", YOB ", YOB),
baseYear = YOB,
- ages=ages(object),
+ ages=ages(object),
deathProbs=deathProbabilities(object, YOB=YOB)
);
})
+setGeneric("undampenTrend", function (object) standardGeneric("undampenTrend"));
+setMethod("undampenTrend", "valuationTable.trendProjection",
+ function (object) {
+ object@dampingFunction=identity;
+ object
+ });
+
makeQxDataFrame = function(..., YOB=1972, Period=NA) {
data=list(...);
@@ -242,7 +249,7 @@ makeQxDataFrame = function(..., YOB=1972, Period=NA) {
cat("Period: ", Period,"\n");
data = lapply(data, function(t) cbind(x=t@ages, y=periodDeathProbabilities(t, Period=Period)))
}
-
+
list.names = names(data)
lns <- sapply(data, nrow)
data <- as.data.frame(do.call("rbind", data))
@@ -254,7 +261,7 @@ plotValuationTables = function(data, ..., title = "", legend.position=c(0.9,0.1)
if (!is.data.frame(data)) {
data = makeQxDataFrame(data, ...);
}
-
+
pl = ggplot(data, aes(x = x, y = y, colour = data$group)) +
theme_bw() +
theme(
@@ -280,7 +287,7 @@ plotValuationTables = function(data, ..., title = "", legend.position=c(0.9,0.1)
breaks = function (limits) seq(max(min(limits),0),max(limits),5),
minor_breaks = function (limits) seq(max(round(min(limits)),0),round(max(limits)),1),
#labels = scales::trans_format('log10', scales::math_format(10^.x))
-
+
) +
annotation_logticks(sides="lr") +
xlab("Alter") + labs(colour="Sterbetafel");
diff --git a/R/ValuationTables_Austria_Annuities.R b/R/ValuationTables_Austria_Annuities.R
index c4385c7af8351fd3d888ecf593e214a44177f685..a52c4f0e70028c99eba00b808f3f6879cf6d9e28 100644
--- a/R/ValuationTables_Austria_Annuities.R
+++ b/R/ValuationTables_Austria_Annuities.R
@@ -4,6 +4,7 @@
# rm(frame_files)
# setwd(dirname(PATH))
+setwd("R")
library("gdata")
@@ -13,8 +14,8 @@ library("gdata")
###############################################################################
rr67.data=read.xls(
- "Tafeln/AVOe_R.xls",
- sheet="OeVM59-61 RR67", skip=1, #row.names=1,
+ "Tables/AVOe_R.xls",
+ sheet="OeVM59-61 RR67", skip=1, #row.names=1,
col.names=c("age","qx"));
rr67=valuationTable.period(
@@ -28,8 +29,8 @@ rr67=valuationTable.period(
###############################################################################
eromf.data=read.xls(
- "Tafeln/AVOe_R.xls",
- sheet="EROM-F Basistafeln", skip=2, #row.names=1,
+ "Tables/AVOe_R.xls",
+ sheet="EROM-F Basistafeln", skip=2, #row.names=1,
col.names=c("age", "EROM85", "EROF85", "EROMG1950", "EROFG1950","","","")
);
@@ -55,8 +56,8 @@ EROF.G1950.female=valuationTable.period(
);
eromf.data.av=read.xls(
- "Tafeln/AVOe_R.xls",
- sheet="EROM-F G AV", skip=1, row.names=1,
+ "Tables/AVOe_R.xls",
+ sheet="EROM-F G AV", skip=1, row.names=1,
col.names=c("YOB", "shiftM", "shiftF")
);
@@ -81,8 +82,8 @@ EROF.G1950.female.av=valuationTable.ageShift(
###############################################################################
AVOe1996R.exakt.data=read.xls(
- "Tafeln/AVOe_R.xls",
- sheet="AVOe 1996R exakt", skip=2, #row.names=1,
+ "Tables/AVOe_R.xls",
+ sheet="AVOe 1996R exakt", skip=2, #row.names=1,
col.names=c("age",
"q1991M", "trendM.long", "trendM.short", "factorMG", "factorM",
"",
@@ -106,7 +107,7 @@ AVOe1996R.trend.switching=function(year) {
AVÖ1996R.male=valuationTable.trendProjection(
name="AVÖ 1996R male",
ages=AVOe1996R.exakt.data$age, baseYear=1991,
- deathProbs=AVOe1996R.exakt.data$q1991M*AVOe1996R.exakt.data$factorM,
+ deathProbs=AVOe1996R.exakt.data$q1991M*AVOe1996R.exakt.data$factorM,
trend=AVOe1996R.exakt.data$trendM.long,
trend2=AVOe1996R.exakt.data$trendM.short,
dampingFunction=AVOe1996R.trend.switching
@@ -114,7 +115,7 @@ AVÖ1996R.male=valuationTable.trendProjection(
AVÖ1996R.female=valuationTable.trendProjection(
name="AVÖ 1996R female",
ages=AVOe1996R.exakt.data$age, baseYear=1991,
- deathProbs=AVOe1996R.exakt.data$q1991F*AVOe1996R.exakt.data$factorF,
+ deathProbs=AVOe1996R.exakt.data$q1991F*AVOe1996R.exakt.data$factorF,
trend=AVOe1996R.exakt.data$trendF.long,
trend2=AVOe1996R.exakt.data$trendF.short,
dampingFunction=AVOe1996R.trend.switching
@@ -122,7 +123,7 @@ AVÖ1996R.female=valuationTable.trendProjection(
AVÖ1996R.male.group=valuationTable.trendProjection(
name="AVÖ 1996R male, group",
ages=AVOe1996R.exakt.data$age, baseYear=1991,
- deathProbs=AVOe1996R.exakt.data$q1991M*AVOe1996R.exakt.data$factorMG,
+ deathProbs=AVOe1996R.exakt.data$q1991M*AVOe1996R.exakt.data$factorMG,
trend=AVOe1996R.exakt.data$trendM.long,
trend2=AVOe1996R.exakt.data$trendM.short,
dampingFunction=AVOe1996R.trend.switching
@@ -130,7 +131,7 @@ AVÖ1996R.male.group=valuationTable.trendProjection(
AVÖ1996R.female.group=valuationTable.trendProjection(
name="AVÖ 1996R female, group",
ages=AVOe1996R.exakt.data$age, baseYear=1991,
- deathProbs=AVOe1996R.exakt.data$q1991F*AVOe1996R.exakt.data$factorFG,
+ deathProbs=AVOe1996R.exakt.data$q1991F*AVOe1996R.exakt.data$factorFG,
trend=AVOe1996R.exakt.data$trendF.long,
trend2=AVOe1996R.exakt.data$trendF.short,
dampingFunction=AVOe1996R.trend.switching
@@ -144,16 +145,16 @@ AVÖ1996R.female.group=valuationTable.trendProjection(
###############################################################################
AVOe2005R.exakt.data=read.xls(
- "Tafeln/AVOe_R.xls",
- sheet="AVOe 2005R", skip=3, #row.names=1,
+ "Tables/AVOe_R.xls",
+ sheet="AVOe 2005R", skip=3, #row.names=1,
header=FALSE,
- col.names=c("age",
- "q2001M","q2001MG", "trendM",
- "q2001F", "q2001FG", "trendF",
- "",
- "q2001M.2Ord", "2001MG.2Ord", "trendM.2Ord",
- "q2001F.2Ord", "q2001FG.2Ord", "trendF.2Ord",
- "",
+ col.names=c("age",
+ "q2001M","q2001MG", "trendM",
+ "q2001F", "q2001FG", "trendF",
+ "",
+ "q2001M.2Ord", "2001MG.2Ord", "trendM.2Ord",
+ "q2001F.2Ord", "q2001FG.2Ord", "trendF.2Ord",
+ "",
"q2001U", "q2001UG", "trendU",
rep("", 10))
);
@@ -182,19 +183,28 @@ AVOe2005R.male.group =AVOe2005R_gen("AVÖ 2005R male group (exact), loaded",
AVOe2005R.female.group=AVOe2005R_gen("AVÖ 2005R female group (exact), loaded", "q2001FG", "trendF");
AVOe2005R.unisex.group=AVOe2005R_gen("AVÖ 2005R unisex group (exact), loaded", "q2001UG", "trendU");
+AVOe2005R.male.nodamping = undampenTrend(AVOe2005R.male);
+AVOe2005R.female.nodamping = undampenTrend(AVOe2005R.female);
+AVOe2005R.unisex.nodamping = undampenTrend(AVOe2005R.unisex);
+AVOe2005R.male.nodamping.unloaded = undampenTrend(AVOe2005R.male.unloaded);
+AVOe2005R.female.nodamping.unloaded = undampenTrend(AVOe2005R.female.unloaded);
+AVOe2005R.male.nodamping.group = undampenTrend(AVOe2005R.male.group);
+AVOe2005R.female.nodamping.group = undampenTrend(AVOe2005R.female.group);
+AVOe2005R.unisex.nodamping.group = undampenTrend(AVOe2005R.unisex.group);
+
###############################################################################
#AVÖ 2005R with age-shifting (Male, Female, unisex), 1st-order only
###############################################################################
AVOe2005R.av.base=read.xls(
- "Tafeln/AVOe_R.xls",
+ "Tables/AVOe_R.xls",
sheet="AVOe 2005R AV Basistafel", skip=1, # row.names=1,
col.names=c("age", "q1965M", "q1965MG", "q1965F", "q1965FG", "q1972U", "q1972UG")
);
AVOe2005R.av.verschiebung=read.xls(
- "Tafeln/AVOe_R.xls",
+ "Tables/AVOe_R.xls",
sheet="AVOe 2005R AV Verschiebung",skip=2,row.names=1,
col.names=c("YOB", "shiftM", "shiftMG", "shiftF", "shiftFG", "shiftU", "shiftUG")
)