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
No related branches found
No related tags found
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
This diff is collapsed.
...@@ -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