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

Lots of improvements

- Implement terme fixe
- Lots more loadings and rebates
- fix some issues with premium and present value calculation
- Calculate total benefix present value (survival, death, premium refund)
- Loadings can be overridden in the contract object (passed to the tarif,
  where the tarif-wide and contract-specific loadings are merged and
  contract-specific settings take precedence)
- First attempt at reserve calcultion
- Move contract class to its own file
- Valuation Tables: add modification function to adjust resulting death
  probabilities (e.g. monotonize, set lower bound for q_x, etc.)
- Properly implement age-shifted tables, add ageShift(table, YOB) function
parent 8165cd4b
Branches
Tags
No related merge requests found
No preview for this file type
...@@ -577,24 +577,30 @@ Bruttoprämie & Zähler & ...@@ -577,24 +577,30 @@ Bruttoprämie & Zähler &
\section{Zuschläge und Abschläge, Vorgeschriebene Prämie} \section{Zuschläge und Abschläge, Vorgeschriebene Prämie}
\begin{longtable}{p{4cm}p{11cm}} \begin{longtable}{p{4cm}p{11cm}}
$StkK$ \dots & Stückkosten pro Jahr (während Prämienzahlungsdauer, einmalig bei Einmalprämien)\\
$oUZu$ \dots & Zuschlag für Vertrag ohne ärztliche Untersuchung\\ $oUZu$ \dots & Zuschlag für Vertrag ohne ärztliche Untersuchung\\
$SuRa=SuRa(VS)$ \dots & Summenrabatt (von Höhe der VS abhängig)\\ $SuRa=SuRa(VS)$ \dots & Summenrabatt (von Höhe der VS abhängig)\\
$VwGew$ \dots & Vorweggewinnbeteiligung in Form eines \%-uellen Rabattes auf die Bruttoprämie\\
$StkK$ \dots & Stückkosten pro Jahr (während Prämienzahlungsdauer, einmalig bei Einmalprämien)\\
$PrRa=PrRa(BP)$ \dots & Prämienrabatt (von Höhe der Bruttoprämie abhängig)\\ $PrRa=PrRa(BP)$ \dots & Prämienrabatt (von Höhe der Bruttoprämie abhängig)\\
$VwGew$ \dots & Vorweggewinnbeteiligung in Form eines Rabattes\\ $VwGew_{StkK}$ \dots & Vorweggewinnbeteiligung in Form eines Rabattes auf die Prämie nach Zu-/Abschlägen (insbesondere nach Stückkosten)\\
$PartnerRa$ \dots & Partnerrabatt auf Prämie nach Zu-/Abschlägen (z.B. bei Abschluss mehrerer Verträge), additiv zu $VwGew_{StkK}$\\
$uz(k)$ \dots & Zuschlag für unterjährige Prämienzahlung ($k$ mal pro Jahr) $uz(k)$ \dots & Zuschlag für unterjährige Prämienzahlung ($k$ mal pro Jahr)
\begin{equation*} \begin{equation*}
uz(k)= uz(k)=\left.\begin{cases}uk_1 & \text {für jährliche}\\uk_2 & \text {für halbjährliche} \\ uk_4 & \text{für quartalsweise}\\uk_{12} & \text{für monatliche}\end{cases}\right\} \text{Prämienzahlung}
\end{equation*} \end{equation*}\\
$VSt$ \dots & Versicherungssteuer (in Österreich 4\% oder 11\%) \\
\end{longtable} \end{longtable}
\begin{align*} Vorgeschriebene Prämie:
\intertext{Vorgeschriebene Prämie:} \begin{multline*}
PV_{\act[x]{n}} &= \left\{ (BP_{\act[x]{n}} + oUZu - SuRa) \cdot VS \cdot (1-VwGew) + StkK\right\} \cdot \frac{1+uz(pz)}{pz} \cdot (1+VSt) PV_{\act[x]{n}} = \left\{ (BP_{\act[x]{n}} + oUZu - SuRa) \cdot VS \cdot (1-VwGew) + StkK\right\} \cdot \\ \left(1-PrRa-VwGew_{StkK}-PartnerRa\right)\cdot \frac{1+uz(k)}{k} \cdot (1+VSt)
% %
\end{align*} \end{multline*}
\pagebreak \pagebreak
......
library("lifecontingencies");
# (virtual) base class for valuation tables, contains only the name / ID
InsuranceContract=setRefClass(
"InsuranceContract",
slots=c(
name="character",
tarif="character",
desc="character",
YOB="numeric",
YOB2="numeric",
age="numeric",
age2="numeric",
contractLength="numeric",
mortalityTable="valuationTable",
mortalityTable2="valuationTable",
interest="numeric",
# cashflows="data.frame",
# deathPayments="list",
# survivalPayments="list",
# costCashflows="data.frame",
cashflows="data.frame",
probabilities="data.frame",
unterjährigkeit="numeric",
unterjährigkeitsapproximation="numeric",
cache.uj="list"
),
prototype=list(
name="Insurance Contract Type",
tarif="Tariff",
desc="Description of the contract",
YOB=1977,
# YOB2=1977,
age=35,
# age2=35,
contractLength=Inf,
mortalityTable=AVOe2005R.unisex,
# mortalityTable2=AVOe2005R.unisex,
interest=0,
deathPayments=list(),
survivalPayments=list(),
costCashflows=data.frame(),
cashflows=data.frame(),
probabilities=data.frame(),
unterjährigkeit=1,
unterjährigkeitsapproximation=1
)
);
# createCostStructure=function(age=35,contractLength=inf, InsuranceContract = R6Class(
# alphaVS, "InsuranceContract",
# alphaBP, public = list(
# tarif = NA,
#
# CostStructure=setClass( #### Contract settings
# "CostStructure", sumInsured = 1,
# YOB = NA,
# ) age = NA,
policyPeriod = Inf,
premiumPeriod = 1,
calcUnterjährigkeit = function(m=1,i=0, order=0) { deferral = 0,
alpha=1; guaranteed = 0,
beta=(m-1)/(2*m);
if (order>=1) { beta = beta + (m^2-1)/(6*m^2)*i; } premiumPayments = PaymentTimeEnum("in advance"),
if (order == 1.5) { beta = beta + (1-m^2)/(12*m^2)*i^2; } benefitPayments = PaymentTimeEnum("in advance"),
if (order >= 2) { beta = beta + (1-m^2)/(24*m^2)*i^2;
alpha= alpha+ (m^2-1)/(12*m^2)*i^2; } premiumFrequency = 1,
list(alpha=alpha, beta=beta); benefitFrequency = 1, # Only for annuities!
}
loadings = list(), # Allow overriding the tariff-defined loadings (see the InsuranceTariff class for all possible names)
setGeneric("createContractCashflows", function(object) standardGeneric("createContractCashflows"))
#### Caching values for this contract, initialized/calculated when the object is created
setGeneric("calculate", function(object) standardGeneric("calculate")); transitionProbabilities = NA,
setMethod("calculate", "InsuranceContract",
function (object) { cashFlowsBasic = NA,
# 0) Prepare helper values cashFlows = NA,
# 0a: Unterjährigkeit cashFlowsCosts = NA,
m = object@unterjährigkeit; premiumSum = 0,
object@cache.uj=calcUnterjährigkeit(m=m, i=object@interest, order=object@unterjährigkeitsapproximation);
presentValues = NA,
presentValuesCosts = NA,
# 1) Generate mortality table
if (!is.null(object@contractLength) && is.finite(object@contractLength)) { premiums = NA,
ages = (object@age):(object@contractLength); reserves = NA,
} else {
ages = (object@age):150;
} #### The code:
qx = deathProbabilities(object@mortalityTable, YOB=object@YOB)[ages+1];
pxn = cumprod(1-qx); initialize = function(tarif, age, policyPeriod,
object@probabilities = data.frame(ages=ages,qx=qx, pxn=pxn) premiumPeriod = policyPeriod, sumInsured = 1,
if (!is.null(object@YOB2)) { ...,
ages2 = ages - object@age + object@age2; loadings = list(),
qx2 = deathProbabilities(object@mortalityTable2, YOB=object@YOB2)[ages2+1]; guaranteed = 0,
pxn2 = cumprod(1-qx2); premiumPayments = "in advance", benefitPayments = "in advance",
pxyn = pxn * pxn2; premiumFrequency = 1, benefitFrequency = 1,
object@probabilities = data.frame(object@probabilities, ages2=ages2, q2=qx2, pxn2=pxn2, pxyn=pxyn); deferral = 0, YOB = 1975) {
} self$tarif = tarif;
self$age = age;
self$policyPeriod = policyPeriod;
# 2) Properly set up the payment and cost cash flow data frames self$premiumPeriod = premiumPeriod;
self$sumInsured = sumInsured;
# 3) Calculate all NPVs of the payment and the cost cash flows (recursively) if (!missing(deferral)) self$deferral = deferral;
# 3a: life-long annuities for person 2 (and person 1+2), in case the death benefit is a life-long widow's annuity if (!missing(YOB)) self$YOB = YOB;
if (!missing(premiumPayments)) self$premiumPayments = premiumPayments;
# 4) Set up the coefficients of the NPVs for the premium calculation if (!missing(benefitPayments)) self$benefitPayments = benefitPayments;
if (!missing(premiumFrequency)) self$premiumFrequency = premiumFrequency;
# 5) Calculate the gross premium if (!missing(benefitFrequency)) self$benefitFrequency = benefitFrequency;
# 6) Calculate the net premium and the Zillmer premium if (!missing(guaranteed)) self$guaranteed = guaranteed;
if (!missing(loadings)) self$loadings = loadings;
# 7) Calculate all reserves (benefits and costs)
self$recalculate();
# 8) Calculate Spar- und Risikoprämie from the net premium and the reserves },
# 9) Calculate VS after Prämienfreistellung recalculate = function() {
# 9a: Calculate all reserves after Prämienfreistellung self$determineTransitionProbabilities();
self$determineCashFlows();
# 10) Calculate the Bilanz reserves self$calculatePresentValues();
self$calculatePremiums();
# 11) Calculate the Rückkaufswert self$calculatePresentValuesAllBenefits();
# max(object@ages,na.rm=TRUE); self$calculateReserves();
object
}) },
determineTransitionProbabilities = function() {
beispielvertrag = InsuranceContract( self$transitionProbabilities = self$tarif$getTransitionProbabilities(YOB = self$YOB, age = self$age);
name="Beispielvertrag", tarif="Beispieltarif", self$transitionProbabilities
desc="Beispiel zum Testen des Codes", },
YOB=1948, YOB2=1948+65-62,
age=65, age2=62, determineCashFlows = function() {
# contractLength=30, self$cashFlowsBasic = self$tarif$getBasicCashFlows(YOB = self$YOB, age = self$age, guaranteed = self$guaranteed, deferral = self$deferral, policyPeriod = self$policyPeriod, premiumPeriod = self$premiumPeriod);
mortalityTable=AVOe2005R.unisex, mortalityTable2=AVOe2005R.unisex, 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);
interest=0.0125, 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);
unterjährigkeit=12, unterjährigkeitsapproximation=1.5, list("benefits"= self$cashFlows, "costs"=self$cashFlowCosts, "premiumSum" = self$premiumSum)
},
# deathPayments=list(),
# survivalPayments=list(), calculatePresentValues = function() {
# costCashflows=data.frame(), self$presentValues = self$tarif$presentValueCashFlows(self$cashFlows, age = self$age, YOB = self$YOB, premiumFrequency = self$premiumFrequency, benefitFrequency = self$benefitFrequency, loadings = self$loadings);
# cashflows=data.frame() self$presentValuesCosts = self$tarif$presentValueCashFlowsCosts(self$cashFlowsCosts, age = self$age, YOB = self$YOB);
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, premiums = self$premiums, sumInsured = self$sumInsured);
self$presentValues = cbind(self$presentValues, pvAllBenefits)
self$presentValues
},
calculatePremiums = function() {
self$premiums = self$tarif$premiumCalculation(self$presentValues, self$presentValuesCosts, premiumSum = self$premiumSum, sumInsured = self$sumInsured, loadings = self$loadings);
self$premiums
},
calculateReserves = function() {
self$reserves = self$tarif$reserveCalculation(premiums=self$premiums, pvBenefits=self$presentValues, pvCosts=self$presentValuesCosts, sumInsured=self$sumInsured, loadings = self$loadings);
},
dummy=NA
)
); );
beispielvertrag=calculate(beispielvertrag)
beispielvertrag
# data.frame(x=0:121, qx=deathProbabilities(AVOe2005R.unisex, YOB=1948))
\ No newline at end of file
...@@ -3,7 +3,7 @@ library(lifecontingencies) ...@@ -3,7 +3,7 @@ library(lifecontingencies)
library(objectProperties) library(objectProperties)
library(foreach) library(foreach)
TariffTypeEnum = setSingleEnum("TariffType", levels = c("annuity", "wholelife", "endowment", "pureendowment")) TariffTypeEnum = setSingleEnum("TariffType", levels = c("annuity", "wholelife", "endowment", "pureendowment", "terme-fix"))
PaymentTimeEnum = setSingleEnum("PaymentTime", levels = c("in advance", "in arrears")) PaymentTimeEnum = setSingleEnum("PaymentTime", levels = c("in advance", "in arrears"))
#PaymentCountEnum = setSingleEnum(PaymentCount, levels = c(1,2,3)) #PaymentCountEnum = setSingleEnum(PaymentCount, levels = c(1,2,3))
...@@ -21,7 +21,7 @@ initializeCosts = function() { ...@@ -21,7 +21,7 @@ initializeCosts = function() {
); );
array(0, array(0,
dim=sapply(dimnm, length), dim=sapply(dimnm, length),
dimnames=dimnames dimnames=dimnm
) )
} }
...@@ -41,7 +41,7 @@ InsuranceTarif = R6Class( ...@@ -41,7 +41,7 @@ InsuranceTarif = R6Class(
mortalityTable = NA, mortalityTable = NA,
i = 0, # guaranteed interest rate i = 0, # guaranteed interest rate
v = 1, # discount factor v = 1, # discount factor
tariffType = TariffTypeEnum("wholelife"), # possible values: annuity, wholelife, endowment, pureendowment tariffType = TariffTypeEnum("wholelife"), # possible values: annuity, wholelife, endowment, pureendowment, terme-fix
premiumFrequencyOrder = 0, premiumFrequencyOrder = 0,
benefitFrequencyOrder = 0, benefitFrequencyOrder = 0,
widowFactor = 0, widowFactor = 0,
...@@ -49,21 +49,21 @@ InsuranceTarif = R6Class( ...@@ -49,21 +49,21 @@ InsuranceTarif = R6Class(
premiumRefund = 0, premiumRefund = 0,
premiumRefundLoading = 0, # Mindesttodesfallrisiko soll damit erreicht werden, z.B. 105% der einbezahlten Prämien premiumRefundLoading = 0, # Mindesttodesfallrisiko soll damit erreicht werden, z.B. 105% der einbezahlten Prämien
advanceBonus = 0,
sumRebate = 0,
costs = list(), costs = list(),
benefitFrequencyLoading = list("1" = 0.0, "2" = 0.0, "4" = 0.0, "12" = 0.0), # TODO: Properly implement this 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 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 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 "tax" = 0.04, # insurance tax, factor on each premium paid
"unitcosts" = 0, # annual unit cost for each policy (Stückkosten), absolute value "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 "security" = 0, # Additional security loading on all benefit payments, factor on all benefits
"noMedicalExam" = 0, # Loading when no medicial exam is done, % of SumInsured "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 "sumRebate" = 0, # gross premium reduction for large premiums, % of SumInsured
"premiumRebate" = 0, # gross premium reduction for large premiums, % of gross premium # TODO "premiumRebate" = 0, # gross premium reduction for large premiums, % of gross premium # TODO
"advanceProfitParticipation" = 0, # Profit participation in advance, % of the premium "advanceProfitParticipation" = 0, # Vorweggewinnbeteiligung (%-Satz der Bruttoprämie)
"ongoingAlphaGrossPremium" = 0 # Acquisition cost that increase the gross premium "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
), ),
...@@ -101,7 +101,6 @@ InsuranceTarif = R6Class( ...@@ -101,7 +101,6 @@ InsuranceTarif = R6Class(
}, },
getBasicCashFlows = function(age, ..., guaranteed = 0, policyPeriod = inf, deferral = 0, maxAge = getOmega(self$mortalityTable)) { getBasicCashFlows = function(age, ..., guaranteed = 0, policyPeriod = inf, deferral = 0, maxAge = getOmega(self$mortalityTable)) {
maxlen = min(maxAge - age, policyPeriod); maxlen = min(maxAge - age, policyPeriod);
cf = list( cf = list(
guaranteed = rep(0, maxlen+1), guaranteed = rep(0, maxlen+1),
survival = rep(0, maxlen+1), survival = rep(0, maxlen+1),
...@@ -110,7 +109,9 @@ InsuranceTarif = R6Class( ...@@ -110,7 +109,9 @@ InsuranceTarif = R6Class(
if (self$tariffType == "annuity") { if (self$tariffType == "annuity") {
# guaranteed payments exist only with annuities (first n years of the payment) # guaranteed payments exist only with annuities (first n years of the payment)
cf$guaranteed = c(rep(0, deferral), rep(1, guaranteed), rep(0, max(0, maxlen+1 - deferral - guaranteed))) cf$guaranteed = c(rep(0, deferral), rep(1, guaranteed), rep(0, max(0, maxlen+1 - deferral - guaranteed)))
cf$survival = c(rep(0, deferral + guaranteed), rep(1, max(0, maxlen+1 - deferral - guaranteed))) cf$survival = c(rep(0, deferral + guaranteed), rep(1, max(0, maxlen - deferral - guaranteed)), 0)
} else if (self$tariffType == "terme-fix") {
cf$guaranteed = c(rep(0, policyPeriod), 1);
} else { } else {
if (self$tariffType == "endowment" || self$tariffType == "pureendowment") { if (self$tariffType == "endowment" || self$tariffType == "pureendowment") {
cf$survival = c(rep(0, policyPeriod), 1); cf$survival = c(rep(0, policyPeriod), 1);
...@@ -205,17 +206,17 @@ InsuranceTarif = R6Class( ...@@ -205,17 +206,17 @@ InsuranceTarif = R6Class(
benefitFrequencyCorrection = correctionPaymentFrequency(m = benefitFrequency, i = self$i, order = self$benefitFrequencyOrder); benefitFrequencyCorrection = correctionPaymentFrequency(m = benefitFrequency, i = self$i, order = self$benefitFrequencyOrder);
premiumFrequencyCorrection = correctionPaymentFrequency(m = premiumFrequency, i = self$i, order = self$premiumFrequencyOrder); 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 = 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, age = ages,
premiums = calculatePVSurvival (q, cashflows$premiums_advance, cashflows$premiums_arrears, m=premiumFrequency, mCorrection=premiumFrequencyCorrection, 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), 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), 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_SumInsured = calculatePVDeath (q, cashflows$death_SumInsured, v=self$v),
death_GrossPremium = calculatePVDeath (q, cashflows$death_GrossPremium, v=self$v), death_GrossPremium = calculatePVDeath (q, cashflows$death_GrossPremium, v=self$v),
death_PremiumFree = calculatePVDeath (q, cashflows$death_PremiumFree, v=self$v), death_PremiumFree = calculatePVDeath (q, cashflows$death_PremiumFree, v=self$v)
row.names = pad0(rownames(qq), len)
)); ));
rownames(pv) <- pad0(rownames(qq), len);
pv pv
}, },
...@@ -228,10 +229,18 @@ InsuranceTarif = R6Class( ...@@ -228,10 +229,18 @@ InsuranceTarif = R6Class(
pvc pvc
}, },
presentValueBenefits = function(presentValues, premiums, sumInsured=1) {
benefits.unit = presentValues[,"survival"] + presentValues[,"death_SumInsured"];
benefits = benefits.unit * sumInsured;
allBenefits.unit = presentValues[,"survival"] + presentValues[,"death_SumInsured"] + presentValues[,"death_GrossPremium"] * premiums[["unit.gross"]];
allBenefits = allBenefits.unit * sumInsured;
cbind(benefits.unit=benefits.unit, benefits=benefits, allBenefits.unit=allBenefits.unit, allBenefits=allBenefits)
},
getPremiumCoefficients = function(type="gross", coeffBenefits, coeffCosts, ..., getPremiumCoefficients = function(type="gross", coeffBenefits, coeffCosts, ...,
premiumSum = 0, loadings = self$loadings, premiumSum = 0,
premiums = c("unit.gross"=0)) { premiums = c("unit.gross"=0)) {
securityLoading = self$loadings$security; securityLoading = loadings$security;
refundAddon = self$premiumRefundLoading; refundAddon = self$premiumRefundLoading;
coefficients = list( coefficients = list(
...@@ -284,11 +293,14 @@ InsuranceTarif = R6Class( ...@@ -284,11 +293,14 @@ InsuranceTarif = R6Class(
coefficients coefficients
}, },
premiumCalculation = function(pvBenefits, pvCosts, costs=self$costs, premiumSum=0, sumInsured=1, premiumFrequency = 1) { premiumCalculation = function(pvBenefits, pvCosts, costs=self$costs, premiumSum=0, sumInsured=1, premiumFrequency = 1, loadings=list(), ...) {
premiums = c("unit.net" = 0, "unit.gross"= 0, "unit.Zillmer" = 0, "net" = 0, "gross" = 0, "Zillmer" = 0, "written" = 0); # The loadings passed to this function override the tariff settings!
loadings = c(loadings, self$loadings);
str(loadings);
premiums = c("unit.net" = 0, "unit.Zillmer" = 0, "unit.gross"= 0, "net" = 0, "Zillmer" = 0, "gross" = 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 # 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) coeff=self$getPremiumCoefficients("gross", pvBenefits["0",]*0, pvCosts["0",,]*0, premiums=premiums, premiumSum=premiumSum, loadings=loadings)
enumerator = sum(coeff[["SumInsured"]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["SumInsured"]][["costs"]] * pvCosts["0",,]); 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",,]); denominator = sum(coeff[["Premium" ]][["benefits"]] * pvBenefits["0",]) + sum(coeff[["Premium" ]][["costs"]] * pvCosts["0",,]);
ongoingAlphaGrossPremium = self$loadings$ongoingAlphaGrossPremium; ongoingAlphaGrossPremium = self$loadings$ongoingAlphaGrossPremium;
...@@ -307,18 +319,31 @@ InsuranceTarif = R6Class( ...@@ -307,18 +319,31 @@ InsuranceTarif = R6Class(
premiums[["unit.Zillmer"]] = enumerator/denominator; premiums[["unit.Zillmer"]] = enumerator/denominator;
premiums[["Zillmer"]] = premiums[["unit.Zillmer"]] * sumInsured; premiums[["Zillmer"]] = premiums[["unit.Zillmer"]] * sumInsured;
# The written premium is the gross premium with additional loadings, rebates, unit costs and taxes # The written premium is the gross premium with additional loadings, rebates, unit costs and taxes
tax = valueOrFunction(self$loadings$tax, sumInsured=sumInsured, premiums=premiums); tax = valueOrFunction(loadings$tax, sumInsured=sumInsured, premiums=premiums);
unitCosts = valueOrFunction(self$loadings$unitcosts, sumInsured=sumInsured, premiums=premiums); unitCosts = valueOrFunction(loadings$unitcosts, sumInsured=sumInsured, premiums=premiums);
noMedicalExam = valueOrFunction(self$loadings$noMedicalExam,sumInsured=sumInsured, premiums=premiums); noMedicalExam = valueOrFunction(loadings$noMedicalExam,sumInsured=sumInsured, premiums=premiums);
sumRebate = valueOrFunction(self$loadings$sumRebate, sumInsured=sumInsured, premiums=premiums); noMedicalExam.relative = valueOrFunction(loadings$noMedicalExamRelative,sumInsured=sumInsured, premiums=premiums);
premiumRebate = valueOrFunction(self$loadings$premiumRebate,sumInsured=sumInsured, premiums=premiums); # TODO: How shall this be included in the premium calculation? sumRebate = valueOrFunction(loadings$sumRebate, sumInsured=sumInsured, premiums=premiums);
advanceProfitParticipation = valueOrFunction(self$loadings$advanceProfitParticipation,sumInsured=sumInsured, premiums=premiums); premiumRebate = valueOrFunction(loadings$premiumRebate,sumInsured=sumInsured, premiums=premiums);
advanceProfitParticipation = valueOrFunction(loadings$advanceProfitParticipation,sumInsured=sumInsured, premiums=premiums);
advanceProfitParticipationUnitCosts = valueOrFunction(loadings$advanceProfitParticipationInclUnitCost, sumInsured=sumInsured, premiums=premiums);
partnerRebate = valueOrFunction(loadings$partnerRebate,sumInsured=sumInsured, premiums=premiums);
frequencyLoading = valueOrFunction(self$premiumFrequencyLoading, sumInsured=sumInsured, premiums=premiums); frequencyLoading = valueOrFunction(self$premiumFrequencyLoading, sumInsured=sumInsured, premiums=premiums);
premiumBeforeTax = (premiums[["unit.gross"]] + noMedicalExam - sumRebate)*sumInsured * (1-advanceProfitParticipation) + unitCosts; str(premiums[["unit.gross"]]*(1+noMedicalExam.relative) + noMedicalExam - sumRebate);
str(sumInsured);
str(1-advanceProfitParticipation);
str(unitCosts);
premiumBeforeTax = (premiums[["unit.gross"]]*(1+noMedicalExam.relative) + noMedicalExam - sumRebate)*sumInsured * (1-advanceProfitParticipation) + unitCosts;
str(premiumBeforeTax);
premiumBeforeTax = premiumBeforeTax * (1-premiumRebate-advanceProfitParticipationUnitCosts-partnerRebate);
str(premiumBeforeTax);
premiumBeforeTax = premiumBeforeTax * (1+frequencyLoading[[toString(premiumFrequency)]]) / premiumFrequency; premiumBeforeTax = premiumBeforeTax * (1+frequencyLoading[[toString(premiumFrequency)]]) / premiumFrequency;
str(premiumBeforeTax);
premiums[["written_beforetax"]] = premiumBeforeTax; premiums[["written_beforetax"]] = premiumBeforeTax;
premiums[["tax"]] = premiumBeforeTax * tax; premiums[["tax"]] = premiumBeforeTax * tax;
premiums[["written"]] = premiumBeforeTax * (1 + tax); premiums[["written"]] = premiumBeforeTax * (1 + tax);
...@@ -326,155 +351,77 @@ InsuranceTarif = R6Class( ...@@ -326,155 +351,77 @@ InsuranceTarif = R6Class(
premiums premiums
}, },
reserveCalculation = function (premiums, pvBenefits, pvCosts, sumInsured=1, ...) {
resZ = pvBenefits[,"allBenefits"]*(1+self$loadings$security) - premiums[["Zillmer"]] * pvBenefits[,"premiums"];
res.gamma = (pvCosts[,"gamma", "SumInsured"] - pvCosts["0", "gamma", "SumInsured"]/pvBenefits["0", "premiums"]*pvBenefits[,"premiums"])*sumInsured;
# res.premiumfree =
# res.gamma.premiumfree =
# Dummy to allow commas res = cbind("Reserve"=resZ, "Reserve.gamma"=res.gamma#, "Reserve.premiumfree"=res.premiumfree, "Reserve.gamma.premiumfree"=res.gamma.premiumfree);
dummy = 0 );
) rownames(res) <- rownames(pvBenefits);
); res
costs = initializeCosts();
# costs["alpha", "SumInsured",] = c(1,2,5);
# costs["beta", "SumPremiums",] = c(3,2,1);
costs["alpha", "SumPremiums", "once"] = 0.05;
costs["Zillmer", "SumPremiums", "once"] = 0.04;
costs["gamma", "SumInsured", "PremiumPeriod"] = 0.005;
costs["gamma", "SumInsured", "PremiumFree"] = 0.01;
costs["gamma_nopremiums", "SumInsured", "PolicyPeriod"] = 0.01;
costs
TestTarif = InsuranceTarif$new(name = "Testtarif", mortalityTable = AVOe2005R.male, type = "annuity", costs=costs)
q = TestTarif$getTransitionProbabilities(YOB = 1980, age = 30)
TestTarif = InsuranceTarif$new(name = "Testtarif", mortalityTable = AVOe2005R.male, type = "wholelife", costs=costs)
TestTarif$getBasicCashFlows(YOB = 1980, age = 30, policyPeriod = 5, deferral = 3, guaranteed=10)
# Gemischte Versicherung, i=1%, AVÖ2005R Unisex, YOB=1980, age=30, Laufzeit=10, Prämienzahlungsdauer=5,
TestTarif = InsuranceTarif$new(name = "Testtarif", mortalityTable = AVOe2005R.unisex, type = "endowment", costs=costs, i=0.01)
TestTarif$getBasicCashFlows(YOB = 1980, age = 30, premiumPaymentPeriod = 5, policyPeriod = 10, deferral = 0, guaranteed=0)
TestTarif$costs=costs;
TestTarif$premiumRefund = 0;
cf = TestTarif$getCashFlows(YOB = 1980, age = 30, premiumPaymentPeriod = 5, policyPeriod = 10, deferral = 0, guaranteed=0); cf
cfc = TestTarif$getCashFlowsCosts(YOB = 1980, age = 30, premiumPaymentPeriod = 5, policyPeriod = 10, deferral = 0, guaranteed=0); cfc
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); premiums
premiums*1000
as.array(premiums)*1000
c("net"=1, "gross"=23, "Zillmer"=44)
str(as.matrix( premiums))
as.matrix(premiums)*1000
scf
cfc
dim(cfc)[1]
str(cf$premiums_advance)
calculatePVSurvival(q$q, cf$premiums_advance, cf$premiums_arrears, v=1/1.01)
calculatePVSurvival(q$q, cf$survival_advance, cf$survival_arrears, v=1/1.01)
calculatePVDeath(q$q, cf$death_SumInsured, v=1/1.01)
calculatePVDeath(q$q, cf$death_GrossPremium, v=1/1.01)
calculatePVDeath(q$q, cf$death_PremiumFree, v=1/1.01)
InsuranceContract = R6Class(
"InsuranceContract",
public = list(
tarif = NA,
#### Contract settings
sumInsured = 1,
YOB = NA,
age = NA,
policyPeriod = Inf,
premiumPeriod = 1,
deferral = 0,
guaranteed = 0,
premiumPayments = PaymentTimeEnum("in advance"),
benefitPayments = PaymentTimeEnum("in advance"),
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,
cashFlowsCosts = NA,
premiumSum = 0,
presentValues = NA,
presentValuesCosts = NA,
premiums = NA,
#### The code:
initialize = function(tarif, age, policyPeriod,
premiumPeriod = policyPeriod, sumInsured = 1,
...,
premiumPayments = "in advance", benefitPayments = "in advance",
premiumFrequency = 1, benefitFrequency = 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;
if (!missing(premiumPayments)) self$premiumPayments = premiumPayments;
if (!missing(benefitPayments)) self$benefitPayments = benefitPayments;
if (!missing(premiumFrequency)) self$premiumFrequency = premiumFrequency;
if (!missing(benefitFrequency)) self$benefitFrequency = benefitFrequency;
self$determineTransitionProbabilities();
self$determineCashFlows();
self$calculatePresentValues();
self$calculatePremiums();
}, },
determineTransitionProbabilities = function() {
self$transitionProbabilities = self$tarif$getTransitionProbabilities(YOB = self$YOB, age = self$age);
self$transitionProbabilities
},
determineCashFlows = function() {
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, benefitPayments = self$benefitPayments, 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, premiumFrequency = self$premiumFrequency, benefitFrequency = self$benefitFrequency);
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 # Dummy to allow commas
dummy = 0
) )
); );
#
#
# costs = initializeCosts();
# # costs["alpha", "SumInsured",] = c(1,2,5);
# # costs["beta", "SumPremiums",] = c(3,2,1);
# costs["alpha", "SumPremiums", "once"] = 0.05;
# costs["Zillmer", "SumPremiums", "once"] = 0.04;
# costs["gamma", "SumInsured", "PremiumPeriod"] = 0.005;
# costs["gamma", "SumInsured", "PremiumFree"] = 0.01;
# costs["gamma_nopremiums", "SumInsured", "PolicyPeriod"] = 0.01;
#
# costs
#
# TestTarif = InsuranceTarif$new(name = "Testtarif", mortalityTable = AVOe2005R.male, type = "annuity", costs=costs)
# q = TestTarif$getTransitionProbabilities(YOB = 1980, age = 30)
# TestTarif = InsuranceTarif$new(name = "Testtarif", mortalityTable = AVOe2005R.male, type = "wholelife", costs=costs)
# TestTarif$getBasicCashFlows(YOB = 1980, age = 30, policyPeriod = 5, deferral = 3, guaranteed=10)
#
# # Gemischte Versicherung, i=1%, AVÖ2005R Unisex, YOB=1980, age=30, Laufzeit=10, Prämienzahlungsdauer=5,
# TestTarif = InsuranceTarif$new(name = "Testtarif", mortalityTable = AVOe2005R.unisex, type = "endowment", costs=costs, i=0.01)
# TestTarif$getBasicCashFlows(YOB = 1980, age = 30, premiumPaymentPeriod = 5, policyPeriod = 10, deferral = 0, guaranteed=0)
#
# TestTarif$costs=costs;
# TestTarif$premiumRefund = 0;
#
# cf = TestTarif$getCashFlows(YOB = 1980, age = 30, premiumPaymentPeriod = 5, policyPeriod = 10, deferral = 0, guaranteed=0); cf
# cfc = TestTarif$getCashFlowsCosts(YOB = 1980, age = 30, premiumPaymentPeriod = 5, policyPeriod = 10, deferral = 0, guaranteed=0); cfc
#
# 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); premiums
#
#
#
# premiums*1000
# as.array(premiums)*1000
#
# c("net"=1, "gross"=23, "Zillmer"=44)
# str(as.matrix( premiums))
# as.matrix(premiums)*1000
# scf
# cfc
# dim(cfc)[1]
#
# str(cf$premiums_advance)
# calculatePVSurvival(q$q, cf$premiums_advance, cf$premiums_arrears, v=1/1.01)
# calculatePVSurvival(q$q, cf$survival_advance, cf$survival_arrears, v=1/1.01)
#
# calculatePVDeath(q$q, cf$death_SumInsured, v=1/1.01)
# calculatePVDeath(q$q, cf$death_GrossPremium, v=1/1.01)
# calculatePVDeath(q$q, cf$death_PremiumFree, v=1/1.01)
#
#
...@@ -4,8 +4,8 @@ library(ggplot2); ...@@ -4,8 +4,8 @@ library(ggplot2);
# (virtual) base class for valuation tables, contains only the name / ID # (virtual) base class for valuation tables, contains only the name / ID
valuationTable=setClass( valuationTable=setClass(
"valuationTable", "valuationTable",
slots=list(name="character", baseYear="numeric", loading="numeric"), slots=list(name="character", baseYear="numeric", loading="numeric", modification="function"),
prototype=list(name="Actuarial Valuation Table", baseYear=2000, loading=0), prototype=list(name="Actuarial Valuation Table", baseYear=2000, loading=0, modification=identity),
contains="VIRTUAL" contains="VIRTUAL"
); );
...@@ -106,53 +106,77 @@ setMethod("ages", "valuationTable.joined", ...@@ -106,53 +106,77 @@ setMethod("ages", "valuationTable.joined",
ages(object@table1); ages(object@table1);
}) })
setGeneric("ageShift", function(object, YOB=1975, ...) standardGeneric("ageShift"));
setMethod("ageShift","valuationTable.ageShift",
function(object, YOB, ...) {
shift = object@ageShifts[toString(YOB),];
if (is.na(shift)) {
# The row names (YOB) are unfortunately strings, so we cannot easily query them.
# TODO: Change the data.frame to use a real column for the YOB
firstYOB = head(rownames(object@ageShifts), n=1);
lastYOB = tail(rownames(object@ageShifts), n=1);
if (YOB < as.integer(firstYOB)) {
shift = object@ageShifts[firstYOB,];
} else if (YOB > as.integer(lastYOB)) {
shift = object@ageShifts[lastYOB,];
}
}
shift
})
setGeneric("deathProbabilities", function(object, ..., YOB=1975) standardGeneric("deathProbabilities")); setGeneric("deathProbabilities", function(object, ..., YOB=1975) standardGeneric("deathProbabilities"));
setMethod("deathProbabilities", "valuationTable.period", setMethod("deathProbabilities", "valuationTable.period",
function(object, ..., YOB=1975) { function(object, ..., YOB=1975) {
object@deathProbs * (1+object@loading); object@modification(object@deathProbs * (1+object@loading));
}) })
setMethod("deathProbabilities","valuationTable.ageShift", setMethod("deathProbabilities","valuationTable.ageShift",
function (object, ..., YOB=1975) { function (object, ..., YOB=1975) {
qx=object@deathProbs * (1+object@loading); qx=object@deathProbs * (1+object@loading);
shift.index=match(YOB, object@shifts, 0); shift = ageShift(object, YOB);
if (shift.index) {} if (shift>0) {
# TODO qx = c(qx[(shift+1):length(qx)], rep(qx[length(qx)], shift));
qx } else if (shift<0) {
qx = c(rep(0, -shift), qx[1:(length(qx)-(-shift))])
}
object@modification(qx)
}) })
setMethod("deathProbabilities","valuationTable.trendProjection", setMethod("deathProbabilities","valuationTable.trendProjection",
function (object, ..., YOB=1975) { function (object, ..., YOB=1975) {
cat("deathProbabilities for valuationTable.trendProjection, YOB=", YOB, "\n")
qx=object@deathProbs * (1+object@loading); qx=object@deathProbs * (1+object@loading);
if (is.null(object@trend2) || length(object@trend2)<=1) { if (is.null(object@trend2) || length(object@trend2)<=1) {
ages=0:(length(qx)-1); ages=0:(length(qx)-1);
damping=sapply(ages, function (age) { object@dampingFunction(YOB+age-object@baseYear) }); damping=sapply(ages, function (age) { object@dampingFunction(YOB+age-object@baseYear) });
# print(data.frame(age=0:(length(qx)-1), trend=object@trend, exponent=-object@trend*damping, damping=damping, baseqx=qx, qx=exp(-object@trend*damping)*qx)[66:90,]); # print(data.frame(age=0:(length(qx)-1), trend=object@trend, exponent=-object@trend*damping, damping=damping, baseqx=qx, qx=exp(-object@trend*damping)*qx)[66:90,]);
exp(-object@trend*damping)*qx; finalqx=exp(-object@trend*damping)*qx;
} else { } else {
# dampingFunction interpolates between the two trends: # dampingFunction interpolates between the two trends:
weights=sapply(YOB+0:(length(qx)-1), object@dampingFunction); weights=sapply(YOB+0:(length(qx)-1), object@dampingFunction);
qx*exp(-(object@trend*(1-weights) + object@trend2*(weights))*(YOB+0:(length(qx)-1)-object@baseYear)) finalqx=qx*exp(-(object@trend*(1-weights) + object@trend2*(weights))*(YOB+0:(length(qx)-1)-object@baseYear))
} }
object@modification(finalqx)
}) })
# data.frame(x=0:121, qx=deathProbabilities(AVOe2005R.unisex, YOB=1948));
setMethod("deathProbabilities","valuationTable.improvementFactors", setMethod("deathProbabilities","valuationTable.improvementFactors",
function (object, ..., YOB=1975) { function (object, ..., YOB=1975) {
qx=object@deathProbs * (1+object@loading); qx=object@deathProbs * (1+object@loading);
(1-object@improvement)^(YOB+0:(length(qx)-1)-object@baseYear)*qx finalqx=(1-object@improvement)^(YOB+0:(length(qx)-1)-object@baseYear)*qx;
object@modification(finalqx)
}) })
setMethod("deathProbabilities","valuationTable.mixed", setMethod("deathProbabilities","valuationTable.mixed",
function (object, ..., YOB=1975) { function (object, ..., YOB=1975) {
qx1=deathProbabilities(object@table1, ..., YOB) * (1+object@loading); qx1=deathProbabilities(object@table1, ..., YOB) * (1+object@loading);
qx2=deathProbabilities(object@table2, ..., YOB) * (1+object@loading); qx2=deathProbabilities(object@table2, ..., YOB) * (1+object@loading);
(object@weight1*qx1 + object@weight2*qx2)/(object@weight1 + object@weight2) mixedqx=(object@weight1*qx1 + object@weight2*qx2)/(object@weight1 + object@weight2);
object@modification(mixedqx)
}) })
setGeneric("periodDeathProbabilities", function(object, ...) standardGeneric("periodDeathProbabilities")); setGeneric("periodDeathProbabilities", function(object, ...) standardGeneric("periodDeathProbabilities"));
setMethod("periodDeathProbabilities", "valuationTable.period", setMethod("periodDeathProbabilities", "valuationTable.period",
function(object, ...) { function(object, ...) {
object@deathProbs * (1+object@loading); object@modification(object@deathProbs * (1+object@loading));
}) })
setMethod("periodDeathProbabilities","valuationTable.ageShift", setMethod("periodDeathProbabilities","valuationTable.ageShift",
function (object, ..., Period=1975) { function (object, ..., Period=1975) {
...@@ -161,7 +185,7 @@ setMethod("periodDeathProbabilities","valuationTable.ageShift", ...@@ -161,7 +185,7 @@ setMethod("periodDeathProbabilities","valuationTable.ageShift",
shift.index=match(YOB, object@shifts, 0); shift.index=match(YOB, object@shifts, 0);
if (shift.index) {} if (shift.index) {}
# TODO # TODO
qx object@modification(qx)
}) })
setMethod("periodDeathProbabilities","valuationTable.trendProjection", setMethod("periodDeathProbabilities","valuationTable.trendProjection",
function (object, ..., Period=1975) { function (object, ..., Period=1975) {
...@@ -170,25 +194,28 @@ setMethod("periodDeathProbabilities","valuationTable.trendProjection", ...@@ -170,25 +194,28 @@ setMethod("periodDeathProbabilities","valuationTable.trendProjection",
ages=0:(length(qx)-1); ages=0:(length(qx)-1);
damping=object@dampingFunction(Period-object@baseYear); damping=object@dampingFunction(Period-object@baseYear);
# print(data.frame(age=0:(length(qx)-1), trend=object@trend, exponent=-object@trend*damping, damping=damping, baseqx=qx, qx=exp(-object@trend*damping)*qx)[66:90,]); # print(data.frame(age=0:(length(qx)-1), trend=object@trend, exponent=-object@trend*damping, damping=damping, baseqx=qx, qx=exp(-object@trend*damping)*qx)[66:90,]);
exp(-object@trend*damping)*qx; finalqx=exp(-object@trend*damping)*qx;
} else { } else {
# TODO # TODO
# dampingFunction interpolates between the two trends: # dampingFunction interpolates between the two trends:
weights=sapply(YOB+0:(length(qx)-1), object@dampingFunction); weights=sapply(YOB+0:(length(qx)-1), object@dampingFunction);
qx*exp(-(object@trend*(1-weights) + object@trend2*(weights))*(YOB+0:(length(qx)-1)-object@baseYear)) finalqx=qx*exp(-(object@trend*(1-weights) + object@trend2*(weights))*(YOB+0:(length(qx)-1)-object@baseYear));
} }
object@modification(finalqx)
}) })
# data.frame(x=0:121, qx=deathProbabilities(AVOe2005R.unisex, YOB=1948)); # data.frame(x=0:121, qx=deathProbabilities(AVOe2005R.unisex, YOB=1948));
setMethod("periodDeathProbabilities","valuationTable.improvementFactors", setMethod("periodDeathProbabilities","valuationTable.improvementFactors",
function (object, ..., Period=1975) { function (object, ..., Period=1975) {
qx=object@deathProbs * (1+object@loading); qx=object@deathProbs * (1+object@loading);
(1-object@improvement)^(Period-object@baseYear)*qx finalqx=(1-object@improvement)^(Period-object@baseYear)*qx;
object@modification(finalqx)
}) })
setMethod("periodDeathProbabilities","valuationTable.mixed", setMethod("periodDeathProbabilities","valuationTable.mixed",
function (object, ..., Period=1975) { function (object, ..., Period=1975) {
qx1=periodDeathProbabilities(object@table1, ..., Period=Period) * (1+object@loading); qx1=periodDeathProbabilities(object@table1, ..., Period=Period) * (1+object@loading);
qx2=periodDeathProbabilities(object@table2, ..., Period=Period) * (1+object@loading); qx2=periodDeathProbabilities(object@table2, ..., Period=Period) * (1+object@loading);
(object@weight1*qx1 + object@weight2*qx2)/(object@weight1 + object@weight2) mixedqx=(object@weight1*qx1 + object@weight2*qx2)/(object@weight1 + object@weight2);
object@modification(mixedqx)
}) })
...@@ -260,10 +287,10 @@ makeQxDataFrame = function(..., YOB=1972, Period=NA) { ...@@ -260,10 +287,10 @@ makeQxDataFrame = function(..., YOB=1972, Period=NA) {
names(data) = lapply(data, function(t) t@name); names(data) = lapply(data, function(t) t@name);
if (missing(Period)) { if (missing(Period)) {
cat("Year of birth: ", YOB, "\n"); cat("Year of birth: ", YOB, "\n");
data = lapply(data, function(t) cbind(x=t@ages, y=deathProbabilities(t, YOB=YOB))) data = lapply(data, function(t) cbind(x=ages(t), y=deathProbabilities(t, YOB=YOB)))
} else { } else {
cat("Period: ", Period,"\n"); cat("Period: ", Period,"\n");
data = lapply(data, function(t) cbind(x=t@ages, y=periodDeathProbabilities(t, Period=Period))) data = lapply(data, function(t) cbind(x=ages(t), y=periodDeathProbabilities(t, Period=Period)))
} }
list.names = names(data) list.names = names(data)
...@@ -312,6 +339,7 @@ plotValuationTables = function(data, ..., title = "", legend.position=c(0.9,0.1) ...@@ -312,6 +339,7 @@ plotValuationTables = function(data, ..., title = "", legend.position=c(0.9,0.1)
} }
pl# + coord_flip() pl# + coord_flip()
} }
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.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(mort.AT.census.2001.male, AVOe2005R.male, YOB=1972, title="Vergleich österreichische Sterbetafeln")
......
...@@ -229,5 +229,6 @@ AVOe2005R.unisex.group.av=AVOe2005R_gen.av("AVÖ 2005R unisex group (age-shifted ...@@ -229,5 +229,6 @@ AVOe2005R.unisex.group.av=AVOe2005R_gen.av("AVÖ 2005R unisex group (age-shifted
############################################################################### ###############################################################################
options("scipen" = 3)
t=AVOe2005R.male; t=AVOe2005R.male;
deathProbabilities(t, YOB=2001) deathProbabilities(t, YOB=2001)
...@@ -58,9 +58,9 @@ mort.AT.census.1991.female = censtable(a.vz.dataF, name="ÖVSt 1990/92 F", baseY ...@@ -58,9 +58,9 @@ mort.AT.census.1991.female = censtable(a.vz.dataF, name="ÖVSt 1990/92 F", baseY
mort.AT.census.2001.female = censtable(a.vz.dataF, name="ÖVSt 2000/02 F", baseYear=2001, qslot="X2000.02"); mort.AT.census.2001.female = censtable(a.vz.dataF, name="ÖVSt 2000/02 F", baseYear=2001, qslot="X2000.02");
mort.AT.census.2011.female = censtable(a.vz.dataF, name="ÖVSt 2010/2012 F", baseYear=2011, qslot="X2010.12"); mort.AT.census.2011.female = censtable(a.vz.dataF, name="ÖVSt 2010/2012 F", baseYear=2011, qslot="X2010.12");
mort.AT.census.2001.unisex = valuationTable.mixed(table1=mort.AT.census.2001.m, table2=mort.AT.census.2001.f) mort.AT.census.2001.unisex = valuationTable.mixed(table1=mort.AT.census.2001.male, table2=mort.AT.census.2001.female)
mort.AT.census.ALL.maleA= makeQxDataFrame( mort.AT.census.ALL.male = makeQxDataFrame(
mort.AT.census.1869.male, mort.AT.census.1869.male,
mort.AT.census.1880.male, mort.AT.census.1880.male,
mort.AT.census.1890.male, mort.AT.census.1890.male,
...@@ -75,7 +75,7 @@ mort.AT.census.ALL.maleA= makeQxDataFrame( ...@@ -75,7 +75,7 @@ mort.AT.census.ALL.maleA= makeQxDataFrame(
mort.AT.census.2001.male, mort.AT.census.2001.male,
mort.AT.census.2011.male); mort.AT.census.2011.male);
mort.AT.census.ALL.female=makeQxDataFrame( mort.AT.census.ALL.female = makeQxDataFrame(
mort.AT.census.1869.female, mort.AT.census.1869.female,
mort.AT.census.1880.female, mort.AT.census.1880.female,
mort.AT.census.1890.female, mort.AT.census.1890.female,
...@@ -94,5 +94,5 @@ rm(a.vz.dataM, a.vz.dataF, censtable) ...@@ -94,5 +94,5 @@ rm(a.vz.dataM, a.vz.dataF, censtable)
############################################################################### ###############################################################################
plotValuationTables(mort.AT.census.ALL.male, title="Vergleich österreichische SterbeTables, Männer", legend.position=c(1,0)) plotValuationTables(mort.AT.census.ALL.male, title="Vergleich österreichische Sterbetafeln, Männer", legend.position=c(1,0))
plotValuationTables(mort.AT.census.ALL.female, title="Vergleich österreichische SterbeTables, Frauen", legend.position=c(1,0)) plotValuationTables(mort.AT.census.ALL.female, title="Vergleich österreichische Sterbetafeln, Frauen", legend.position=c(1,0))
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment