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

Implement premium calculation (grosss, net, Zillmer, written, tax)

parent 6b3026af
No related branches found
No related tags found
No related merge requests found
Hide whitespace changes
Inline Side-by-side
Formulas_Reference/.gitignore
+ 1
− 0
View file @ 1bccc58d
......@@ -4,3 +4,4 @@
*.synctex.gz
*.backup
*.kilepr
Bernkopf Max
R/HelperFunctions.R
+ 12
− 3
View file @ 1bccc58d
......@@ -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
}
}
R/InsuranceTarif.R
+ 125
− 196
View file @ 1bccc58d
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))
R/ValuationTables.R
+ 28
− 21
View file @ 1bccc58d
......@@ -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");
......
R/ValuationTables_Austria_Annuities.R
+ 33
− 23
View file @ 1bccc58d
......@@ -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")
)
......
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment