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
......@@ -4,3 +4,4 @@
*.synctex.gz
*.backup
*.kilepr
Bernkopf Max
......@@ -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
}
}
This diff is collapsed.
......@@ -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");
......
......@@ -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% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment