diff --git a/DESCRIPTION b/DESCRIPTION index 0d7be5c3660265276a3e7a7b94fcd2ea00cc726e..53403f352e5316967e8e272695f1135aa212ffd5 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -1,9 +1,9 @@ Package: ValuationTables Type: Package -Title: What the package does (short line) +Title: A framework for cohort life tables and general life insurance contracts Version: 1.0 -Date: 2013-05-03 -Author: Who wrote it -Maintainer: Who to complain to <yourfault@somewhere.net> -Description: More about what it does (maybe more than one line) -License: What license is it under? +Date: 2016-04-01 +Author: Reinhold Kainhofer <reinhold@kainhofer.com> +Maintainer: Reinhold Kainhofer <reinhold@kainhofer.com> +Description: Yet to be written +License: Not yet finally decided, probably GPL v3+ or LGPL or something similar diff --git a/R/InsuranceContract.R b/R/InsuranceContract.R new file mode 100644 index 0000000000000000000000000000000000000000..016450b1c7b8866c548fc088097d034874bd3846 --- /dev/null +++ b/R/InsuranceContract.R @@ -0,0 +1,154 @@ +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, +# 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)) \ No newline at end of file diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R new file mode 100644 index 0000000000000000000000000000000000000000..3079f3c1833b43e3300c13978ba0ceb3bc896f24 --- /dev/null +++ b/R/InsuranceTarif.R @@ -0,0 +1,154 @@ +library("lifecontingencies"); + + +# (virtual) base class for valuation tables, contains only the name / ID +InsuranceTarif=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, +# 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)) \ No newline at end of file diff --git a/R/S4classes.R b/R/S4classes.R index 42f5e357712ce2dc6d8ae5c4ffb91926eec4cbda..69ff3b12720942e538a66171a9869f198c6fd1c0 100644 --- a/R/S4classes.R +++ b/R/S4classes.R @@ -1,10 +1,11 @@ library("lifecontingencies"); +library(ggplot2); # (virtual) base class for valuation tables, contains only the name / ID valuationTable=setClass( "valuationTable", - slots=list(name="character"), - prototype=list(name="Actuarial Valuation Table"), + slots=list(name="character", baseYear="numeric"), + prototype=list(name="Actuarial Valuation Table", baseYear=2000), contains="VIRTUAL" ); @@ -67,6 +68,13 @@ valuationTable.joined=setClass( 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", + slots=c(table1="valuationTable", table2="valuationTable", weight1="numeric", weight2="numeric"), + prototype=list(weight1=1/2, weight2=1/2), + contains="valuationTable" +); @@ -84,30 +92,38 @@ setMethod("deathProbabilities", "valuationTable.period", setMethod("deathProbabilities","valuationTable.ageShift", function (object, ..., YOB=1975) { qx=object@deathProbs; - shift.index=match(YOB, object@shifts, YOB); + shift.index=match(YOB, object@shifts, 0); if (shift.index) {} - # shift= +# TODO qx }) setMethod("deathProbabilities","valuationTable.trendProjection", function (object, ..., YOB=1975) { qx=object@deathProbs; - if (length(object@trend2)<=1) { -#print("length(object@trend2)==0"); - exp(-object@trend*object@dampingFunction(YOB+0:(length(qx)-1)-object@baseYear))*qx + if (is.null(object@trend2) || length(object@trend2)<=1) { + ages=0:(length(qx)-1); + 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,]); + exp(-object@trend*damping)*qx; } else { -#print("length(object@trend2)!=0"); -#print(length(object@trend2)); # dampingFunction interpolates between the two trends: 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)) } }) +# data.frame(x=0:121, qx=deathProbabilities(AVOe2005R.unisex, YOB=1948)); setMethod("deathProbabilities","valuationTable.improvementFactors", function (object, ..., YOB=1975) { qx=object@deathProbs; (1-object@improvement)^(YOB+0:(length(qx)-1)-object@baseYear)*qx }) +setMethod("deathProbabilities","valuationTable.mixed", + function (object, ..., YOB=1975) { + qx1=deathProbabilities(object@table1, ..., YOB); + qx2=deathProbabilities(object@table2, ..., YOB); + (object@weight1*qx1 + object@weight2*qx2)/(object@weight1 + object@weight2) + }) + setGeneric("lifeTable", function(object, ...) standardGeneric("lifeTable")); setMethod("lifeTable","valuationTable", function (object, ...) { @@ -117,3 +133,56 @@ setMethod("lifeTable","valuationTable", }) +setGeneric("baseYear", function(object, ...) standardGeneric("baseYear")); +setMethod("baseYear","valuationTable", + function (object, ...) { + object@baseYear + }) +setMethod("baseYear","valuationTable.mixed", + function (object, ...) { + baseYear(object@table1) + }) + +setGeneric("baseTable", function(object, ...) standardGeneric("baseTable")); +setMethod("baseTable","valuationTable", + function (object, ...) { + c() + }) +setMethod("baseTable","valuationTable.period", + function (object, ...) { + object@deathProbs + }) + + +makeQxDataFrame = function(...) { + data=list(...); + names(data) = lapply(data, function(t) t@name); + data = lapply(data, function(t) cbind(x=t@ages, y=t@deathProbs)) + + list.names = names(data) + lns <- sapply(data, nrow) + data <- as.data.frame(do.call("rbind", data)) + data$group <- rep(list.names, lns) + data +} + +plotValuationTables = function(..., title = "") { + data = makeQxDataFrame(...); + + pl = ggplot(data, aes(x = x, y = y, colour = data$group)) + + theme_bw() + + theme( + plot.title = element_text(size=18, face="bold"), + legend.title = element_text(size=14, face="bold.italic") + ) + + geom_line() + + scale_y_log10(#breaks = trans_breaks('log10', function(x) 10^x), + #labels = trans_format('log10', math_format(10^.x)), + #minor_breaks = log(c(sapply(x, function(x) seq(0, x, x/10))), 10) + ) + + xlab("Alter") + ylab("q_x") + labs(colour="Sterbetafel"); + if (title != "") { + pl = pl + ggtitle("Österreichische Volkssterbetafeln Männer seit 1870"); + } + pl +} diff --git a/R/Tables/AVOe_R.xls b/R/Tables/AVOe_R.xls new file mode 100644 index 0000000000000000000000000000000000000000..20cc56a9ce25c3d51b8c50e51728efb4e18039a7 Binary files /dev/null and b/R/Tables/AVOe_R.xls differ diff --git a/R/Tables/A_Volkszaehlungen.xls b/R/Tables/A_Volkszaehlungen.xls new file mode 100644 index 0000000000000000000000000000000000000000..8cdf54749a6cc99045de2fcd8fc0294c4b29a998 Binary files /dev/null and b/R/Tables/A_Volkszaehlungen.xls differ diff --git a/Tafeln/DAV_2004_R.xls b/R/Tables/DAV_2004_R.xls similarity index 100% rename from Tafeln/DAV_2004_R.xls rename to R/Tables/DAV_2004_R.xls diff --git a/Tafeln/DAV_R.xls b/R/Tables/DAV_R.xls similarity index 100% rename from Tafeln/DAV_R.xls rename to R/Tables/DAV_R.xls diff --git a/Tafeln/DAV_T.xls b/R/Tables/DAV_T.xls similarity index 100% rename from Tafeln/DAV_T.xls rename to R/Tables/DAV_T.xls diff --git a/Tafeln/Overview_Tables.ods b/R/Tables/Overview_Tables.ods similarity index 100% rename from Tafeln/Overview_Tables.ods rename to R/Tables/Overview_Tables.ods diff --git a/Tafeln/USA_Annuities.xls b/R/Tables/USA_Annuities.xls similarity index 98% rename from Tafeln/USA_Annuities.xls rename to R/Tables/USA_Annuities.xls index e0456b95c48c69794249ada1cd7ec299be4bf55d..30ca63d2dfce66ad899391dd3152c8e14e475cae 100644 Binary files a/Tafeln/USA_Annuities.xls and b/R/Tables/USA_Annuities.xls differ diff --git a/R/ValuationTables.R b/R/ValuationTables.R new file mode 100644 index 0000000000000000000000000000000000000000..5dd2ca94d4edf808304d355d36f9ec7fcc681001 --- /dev/null +++ b/R/ValuationTables.R @@ -0,0 +1,118 @@ +library("lifecontingencies"); + +# (virtual) base class for valuation tables, contains only the name / ID +valuationTable=setClass( + "valuationTable", + slots=list(name="character"), + prototype=list(name="Actuarial Valuation Table"), + contains="VIRTUAL" +); + + +# 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", + 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 +# for a base YOB) +valuationTable.ageShift=setClass( + "valuationTable.ageShift", + slots=list(ageShifts="data.frame"), + prototype=list(ageShifts=data.frame(YOB=c(), shifts=c())), + contains="valuationTable.period" +); + +# A cohort life table, obtained by a trend projection from a given base table +# (PODs for a given observation year). Typically, the trend is obtained by +# the Lee-Carter method or some other trend estimation. +# 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", + 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 +# from a given base table (PODs for a given observation year). +valuationTable.improvementFactors=setClass( + "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 +# per year and age) +valuationTable.observed=setClass( + "valuationTable.observed", + slots=list(data="data.frame"), + prototype=list(data=data.frame()), + contains="valuationTable" +); + +# A cohort life table obtained by joining two cohort life tables, each of which +# 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", + slots=list( + table1="valuationTable", yearRange1="numeric", + table2="valuationTable", yearRange2="numeric"), + contains="valuationTable" +); + + + +setGeneric("getOmega", function(object) standardGeneric("getOmega")); +setMethod("getOmega", "valuationTable.period", + function (object) { + max(object@ages,na.rm=TRUE); + }) + +setGeneric("deathProbabilities", function(object, ..., YOB=1975) standardGeneric("deathProbabilities")); +setMethod("deathProbabilities", "valuationTable.period", + function(object, ..., YOB=1975) { + object@deathProbs; + }) +setMethod("deathProbabilities","valuationTable.ageShift", + function (object, ..., YOB=1975) { + qx=object@deathProbs; + shift.index=match(YOB, object@shifts, 0); + if (shift.index) {} + # shift= + qx + }) +setMethod("deathProbabilities","valuationTable.trendProjection", + function (object, ..., YOB=1975) { + qx=object@deathProbs; + if (length(object@trend2)<=1) { + exp(-object@trend*object@dampingFunction(YOB+0:(length(qx)-1)-object@baseYear))*qx + #exp(-object@trend*object@dampingFunction(YOB+0:(length(qx)-1)-object@baseYear)) + #qx + } else { + # dampingFunction interpolates between the two trends: + 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)) + } + }) +setMethod("deathProbabilities","valuationTable.improvementFactors", + function (object, ..., YOB=1975) { + qx=object@deathProbs; + (1-object@improvement)^(YOB+0:(length(qx)-1)-object@baseYear)*qx + }) +setGeneric("lifeTable", function(object, ...) standardGeneric("lifeTable")); +setMethod("lifeTable","valuationTable", + function (object, ...) { + qx=deathProbabilities(object, ...); + if (qx[[length(qx)]]!=1) { qx=c(qx, 1, 1); } + probs2lifetable(qx, type="qx") + }) + + diff --git a/R/ValuationTables_Austria_Annuities.R b/R/ValuationTables_Austria_Annuities.R index 65f4ca36f47102f14ef79db65cea8de1c46bfd89..3b6f19296b42d29f2959af0e810100811cf94bbd 100644 --- a/R/ValuationTables_Austria_Annuities.R +++ b/R/ValuationTables_Austria_Annuities.R @@ -1,8 +1,8 @@ -frame_files = lapply(sys.frames(), function(x) x$ofile) -frame_files = Filter(Negate(is.null), frame_files) -PATH <- dirname(frame_files[[length(frame_files)]]) -rm(frame_files) -setwd(dirname(PATH)) +# frame_files = lapply(sys.frames(), function(x) x$ofile) +# frame_files = Filter(Negate(is.null), frame_files) +# PATH <- dirname(frame_files[[length(frame_files)]]) +# rm(frame_files) +# setwd(dirname(PATH)) library("gdata") @@ -30,7 +30,7 @@ rr67=valuationTable.period( eromf.data=read.xls( "Tafeln/AVOe_R.xls", sheet="EROM-F Basistafeln", skip=2, #row.names=1, - col.names=c("age", "EROM85", "EROF85", "EROMG1950", "EROFG1950") + col.names=c("age", "EROM85", "EROF85", "EROMG1950", "EROFG1950","","","") ); @@ -44,12 +44,14 @@ erom85.female=valuationTable.period( EROM.G1950.male=valuationTable.period( name="EROM G 1950 Basistafel, male", ages=eromf.data$age, - deathProbs=eromf.data$EROMG1950 + deathProbs=eromf.data$EROMG1950, + baseYear=1950 ); EROF.G1950.female=valuationTable.period( name="EROF G 1950 Basistafel, female", ages=eromf.data$age, - deathProbs=eromf.data$EROFG1950 + deathProbs=eromf.data$EROFG1950, + baseYear=1950 ); eromf.data.av=read.xls( @@ -62,13 +64,15 @@ EROM.G1950.male.av=valuationTable.ageShift( name="EROM G 1950 mit Altersverschiebung, male", ages=eromf.data$age, deathProbs=eromf.data$EROMG1950, - ageShifts=eromf.data.av[1] + ageShifts=eromf.data.av[1], + baseYear=1950 ); EROF.G1950.female.av=valuationTable.ageShift( name="EROF G 1950 mit Altersverschiebung, female", ages=eromf.data$age, deathProbs=eromf.data$EROFG1950, - ageShifts=eromf.data.av[2] + ageShifts=eromf.data.av[2], + baseYear=1950 ); @@ -76,16 +80,16 @@ EROF.G1950.female.av=valuationTable.ageShift( # AVÖ 1996R exact (Male, Female), 1st-order only ############################################################################### -avoe1996r.exakt.data=read.xls( +AVOe1996R.exakt.data=read.xls( "Tafeln/AVOe_R.xls", sheet="AVOe 1996R exakt", skip=2, #row.names=1, col.names=c("age", "q1991M", "trendM.long", "trendM.short", "factorMG", "factorM", "", "q1991F", "trendF.long", "trendF.short", "factorFG", "factorF", - rep("",12)) + rep("",16)) ); -avoe1996r.trend.switching=function(year) { +AVOe1996R.trend.switching=function(year) { if (year<=1971) { 15/(1991-year) } else if (1971<year && year<1981) { @@ -101,35 +105,35 @@ 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, - trend=avoe1996r.exakt.data$trendM.long, - trend2=avoe1996r.exakt.data$trendM.short, - dampingFunction=avoe1996r.trend.switching + ages=AVOe1996R.exakt.data$age, baseYear=1991, + 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 ); 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, - trend=avoe1996r.exakt.data$trendF.long, - trend2=avoe1996r.exakt.data$trendF.short, - dampingFunction=avoe1996r.trend.switching + ages=AVOe1996R.exakt.data$age, baseYear=1991, + 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 ); 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, - trend=avoe1996r.exakt.data$trendM.long, - trend2=avoe1996r.exakt.data$trendM.short, - dampingFunction=avoe1996r.trend.switching + ages=AVOe1996R.exakt.data$age, baseYear=1991, + 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 ); 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, - trend=avoe1996r.exakt.data$trendF.long, - trend2=avoe1996r.exakt.data$trendF.short, - dampingFunction=avoe1996r.trend.switching + ages=AVOe1996R.exakt.data$age, baseYear=1991, + 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 ); @@ -139,9 +143,9 @@ AVÖ1996R.female.group=valuationTable.trendProjection( # gender-specific tables also have 2nd-order tables, unisex only 1st-order table ############################################################################### -avoe2005r.exakt.data=read.xls( +AVOe2005R.exakt.data=read.xls( "Tafeln/AVOe_R.xls", - sheet="AVOe 2005R", skip=1, #row.names=1, + sheet="AVOe 2005R", skip=3, #row.names=1, header=FALSE, col.names=c("age", "q2001M","q2001MG", "trendM", @@ -150,65 +154,66 @@ avoe2005r.exakt.data=read.xls( "q2001M.2Ord", "2001MG.2Ord", "trendM.2Ord", "q2001F.2Ord", "q2001FG.2Ord", "trendF.2Ord", "", - "q2001U", "q2001UG", "trendU") + "q2001U", "q2001UG", "trendU", + rep("", 10)) ); -avoe2005r.trend.damping=function(t) { +AVOe2005R.trend.damping=function(t) { 100*atan(t/100) } -avoe2005r_gen=function(nm, probs, trend) { +AVOe2005R_gen=function(nm, probs, trend) { with( - avoe2005r.exakt.data, + AVOe2005R.exakt.data, valuationTable.trendProjection( name=nm, ages=age, baseYear=2001, - deathProbs=avoe2005r.exakt.data[[probs]], trend=avoe2005r.exakt.data[[trend]], - dampingFunction=avoe2005r.trend.damping + deathProbs=AVOe2005R.exakt.data[[probs]], trend=AVOe2005R.exakt.data[[trend]], + dampingFunction=AVOe2005R.trend.damping ) ) } -avoe2005r.male =avoe2005r_gen("AVÖ 2005R male (exact), loaded", "q2001M", "trendM"); -avoe2005r.female=avoe2005r_gen("AVÖ 2005R female (exact), loaded", "q2001F", "trendF"); -avoe2005r.unisex=avoe2005r_gen("AVÖ 2005R unisex (exact), loaded", "q2001U", "trendU"); -avoe2005r.male.unloaded =avoe2005r_gen("AVÖ 2005R male (exact), unloaded", "q2001M.2Ord", "trendM.2Ord"); -avoe2005r.female.unloaded=avoe2005r_gen("AVÖ 2005R female (exact), unloaded", "q2001F.2Ord", "trendF.2Ord"); -avoe2005r.male.group =avoe2005r_gen("AVÖ 2005R male group (exact), loaded", "q2001MG", "trendM"); -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 =AVOe2005R_gen("AVÖ 2005R male (exact), loaded", "q2001M", "trendM"); +AVOe2005R.female=AVOe2005R_gen("AVÖ 2005R female (exact), loaded", "q2001F", "trendF"); +AVOe2005R.unisex=AVOe2005R_gen("AVÖ 2005R unisex (exact), loaded", "q2001U", "trendU"); +AVOe2005R.male.unloaded =AVOe2005R_gen("AVÖ 2005R male (exact), unloaded", "q2001M.2Ord", "trendM.2Ord"); +AVOe2005R.female.unloaded=AVOe2005R_gen("AVÖ 2005R female (exact), unloaded", "q2001F.2Ord", "trendF.2Ord"); +AVOe2005R.male.group =AVOe2005R_gen("AVÖ 2005R male group (exact), loaded", "q2001MG", "trendM"); +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"); ############################################################################### #AVÖ 2005R with age-shifting (Male, Female, unisex), 1st-order only ############################################################################### -avoe2005r.av.base=read.xls( +AVOe2005R.av.base=read.xls( "Tafeln/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( +AVOe2005R.av.verschiebung=read.xls( "Tafeln/AVOe_R.xls", sheet="AVOe 2005R AV Verschiebung",skip=2,row.names=1, col.names=c("YOB", "shiftM", "shiftMG", "shiftF", "shiftFG", "shiftU", "shiftUG") ) -avoe2005r_gen.av=function(nm, probs, shft) { +AVOe2005R_gen.av=function(nm, probs, shft) { valuationTable.ageShift( name=nm, - ages=avoe2005r.av.base$age, - deathProbs=avoe2005r.av.base[[probs]], - ageShifts=na.omit(avoe2005r.av.verschiebung[shft]) + ages=AVOe2005R.av.base$age, + deathProbs=AVOe2005R.av.base[[probs]], + ageShifts=na.omit(AVOe2005R.av.verschiebung[shft]) ) } -avoe2005r.male.av =avoe2005r_gen.av("AVÖ 2005R male (age-shifted), loaded", "q1965M", "shiftM"); -avoe2005r.female.av=avoe2005r_gen.av("AVÖ 2005R female (age-shifted), loaded", "q1965F", "shiftF"); -avoe2005r.unisex.av=avoe2005r_gen.av("AVÖ 2005R unisex (age-shifted), loaded", "q1972U", "shiftU"); -avoe2005r.male.group.av =avoe2005r_gen.av("AVÖ 2005R male group (age-shifted), loaded", "q1965MG", "shiftMG"); -avoe2005r.female.group.av=avoe2005r_gen.av("AVÖ 2005R female group (age-shifted), loaded", "q1965FG", "shiftFG"); -avoe2005r.unisex.group.av=avoe2005r_gen.av("AVÖ 2005R unisex group (age-shifted), loaded", "q1972UG", "shiftUG"); +AVOe2005R.male.av =AVOe2005R_gen.av("AVÖ 2005R male (age-shifted), loaded", "q1965M", "shiftM"); +AVOe2005R.female.av=AVOe2005R_gen.av("AVÖ 2005R female (age-shifted), loaded", "q1965F", "shiftF"); +AVOe2005R.unisex.av=AVOe2005R_gen.av("AVÖ 2005R unisex (age-shifted), loaded", "q1972U", "shiftU"); +AVOe2005R.male.group.av =AVOe2005R_gen.av("AVÖ 2005R male group (age-shifted), loaded", "q1965MG", "shiftMG"); +AVOe2005R.female.group.av=AVOe2005R_gen.av("AVÖ 2005R female group (age-shifted), loaded", "q1965FG", "shiftFG"); +AVOe2005R.unisex.group.av=AVOe2005R_gen.av("AVÖ 2005R unisex group (age-shifted), loaded", "q1972UG", "shiftUG"); diff --git a/R/ValuationTables_Austria_Census.R b/R/ValuationTables_Austria_Census.R new file mode 100644 index 0000000000000000000000000000000000000000..7096d1a5d26a23bbfc190703014197651afc0a36 --- /dev/null +++ b/R/ValuationTables_Austria_Census.R @@ -0,0 +1,111 @@ +# frame_files = lapply(sys.frames(), function(x) x$ofile) +# frame_files = Filter(Negate(is.null), frame_files) +# PATH <- dirname(frame_files[[length(frame_files)]]) +# rm(frame_files) +# setwd(dirname(PATH)) + +library("gdata") + + + +############################################################################### +### Volkszählungen Österreich +############################################################################### + +a.vz.dataM=read.xls( + "Tafeln/A_Volkszaehlungen.xls", + sheet="Austria_M", + skip=2, + header=TRUE +) +a.vz.dataF=read.xls( + "Tafeln/A_Volkszaehlungen.xls", + sheet="Austria_F", + skip=2, + header=TRUE +) +censtable = function(data, name, qslot, baseYear=1900) { + qx=data[names(data)==qslot]; + ix=complete.cases(qx); + valuationTable.period(name=name, ages=data$x[ix], deathProbs=qx[ix,], baseYear=baseYear) +} + +mort.AT.census.1869.male = censtable(a.vz.dataM, name="ÖVSt 1868/71 M", baseYear=1869, qslot="X1868.71"); +mort.AT.census.1880.male = censtable(a.vz.dataM, name="ÖVSt 1879/82 M", baseYear=1880, qslot="X1879.82"); +mort.AT.census.1890.male = censtable(a.vz.dataM, name="ÖVSt 1889/92 M", baseYear=1890, qslot="X1889.92"); +mort.AT.census.1900.male = censtable(a.vz.dataM, name="ÖVSt 1899/1902 M", baseYear=1900, qslot="X1899.1902"); +mort.AT.census.1910.male = censtable(a.vz.dataM, name="ÖVSt 1909/12 M", baseYear=1910, qslot="X1909.12"); +mort.AT.census.1931.male = censtable(a.vz.dataM, name="ÖVSt 1930/33 M", baseYear=1931, qslot="X1930.33"); +mort.AT.census.1951.male = censtable(a.vz.dataM, name="ÖVSt 1949/51 M", baseYear=1951, qslot="X1949.51"); +mort.AT.census.1961.male = censtable(a.vz.dataM, name="ÖVSt 1959/61 M", baseYear=1961, qslot="X1959.61"); +mort.AT.census.1971.male = censtable(a.vz.dataM, name="ÖVSt 1970/72 M", baseYear=1971, qslot="X1970.72"); +mort.AT.census.1981.male = censtable(a.vz.dataM, name="ÖVSt 1980/82 M", baseYear=1981, qslot="X1980.82"); +mort.AT.census.1991.male = censtable(a.vz.dataM, name="ÖVSt 1990/92 M", baseYear=1991, qslot="X1990.92"); +mort.AT.census.2001.male = censtable(a.vz.dataM, name="ÖVSt 2000/02 M", baseYear=2001, qslot="X2000.02"); +mort.AT.census.2011.male = censtable(a.vz.dataM, name="ÖVSt 2010/2012 M", baseYear=2011, qslot="X2010.12"); + +mort.AT.census.1869.female = censtable(a.vz.dataF, name="ÖVSt 1868/71 F", baseYear=1869, qslot="X1868.71"); +mort.AT.census.1880.female = censtable(a.vz.dataF, name="ÖVSt 1879/82 F", baseYear=1880, qslot="X1879.82"); +mort.AT.census.1890.female = censtable(a.vz.dataF, name="ÖVSt 1889/92 F", baseYear=1890, qslot="X1889.92"); +mort.AT.census.1900.female = censtable(a.vz.dataF, name="ÖVSt 1899/1902 F", baseYear=1900, qslot="X1899.1902"); +mort.AT.census.1910.female = censtable(a.vz.dataF, name="ÖVSt 1909/12 F", baseYear=1910, qslot="X1909.12"); +mort.AT.census.1931.female = censtable(a.vz.dataF, name="ÖVSt 1930/33 F", baseYear=1931, qslot="X1930.33"); +mort.AT.census.1951.female = censtable(a.vz.dataF, name="ÖVSt 1949/51 F", baseYear=1951, qslot="X1949.51"); +mort.AT.census.1961.female = censtable(a.vz.dataF, name="ÖVSt 1959/61 F", baseYear=1961, qslot="X1959.61"); +mort.AT.census.1971.female = censtable(a.vz.dataF, name="ÖVSt 1970/72 F", baseYear=1971, qslot="X1970.72"); +mort.AT.census.1981.female = censtable(a.vz.dataF, name="ÖVSt 1980/82 F", baseYear=1981, qslot="X1980.82"); +mort.AT.census.1991.female = censtable(a.vz.dataF, name="ÖVSt 1990/92 F", baseYear=1991, qslot="X1990.92"); +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.2001.unisex = valuationTable.mixed(table1=mort.AT.census.2001.m, table2=mort.AT.census.2001.f) + +mort.AT.census.ALL.maleA= makeQxDataFrame( + mort.AT.census.1869.male, + mort.AT.census.1880.male, + mort.AT.census.1890.male, + mort.AT.census.1900.male, + mort.AT.census.1910.male, + mort.AT.census.1931.male, + mort.AT.census.1951.male, + mort.AT.census.1961.male, + mort.AT.census.1971.male, + mort.AT.census.1981.male, + mort.AT.census.1991.male, + mort.AT.census.2001.male, + mort.AT.census.2011.male); + +mort.AT.census.ALL.female=makeQxDataFrame( + mort.AT.census.1869.female, + mort.AT.census.1880.female, + mort.AT.census.1890.female, + mort.AT.census.1900.female, + mort.AT.census.1910.female, + mort.AT.census.1931.female, + mort.AT.census.1951.female, + mort.AT.census.1961.female, + mort.AT.census.1971.female, + mort.AT.census.1981.female, + mort.AT.census.1991.female, + mort.AT.census.2001.female, + mort.AT.census.2011.female); + +rm(a.vz.dataM, a.vz.dataF, censtable) + +############################################################################### + +ggplot(mort.AT.census.ALL.maleA, aes(x = x, y = y, colour = mort.AT.census.ALL.maleA$group)) + + theme_bw() + + theme( + plot.title = element_text(size=18, face="bold"), + legend.title = element_text(size=14, face="bold.italic") + ) + + geom_line() + + scale_y_log10(#breaks = trans_breaks('log10', function(x) 10^x), + #labels = trans_format('log10', math_format(10^.x)), + #minor_breaks = log(c(sapply(x, function(x) seq(0, x, x/10))), 10) + ) + + ggtitle("Österreichische Volkssterbetafeln Männer seit 1870") + xlab("Alter") + ylab("q_x") + labs(colour="Sterbetafel") + + +plotValuationTables(mort.AT.census.1869.male, mort.AT.census.1869.female, mort.AT.census.2011.male, mort.AT.census.2011.female, title="Vergleich österreichische Sterbetafeln") diff --git a/R/ValuationTables_Germany_LifeInsurance.R b/R/ValuationTables_Germany_LifeInsurance.R index 9d93f5f1b98b3c3bd2ebd68d266f5639d7c12138..56f5949d00288bcab5f90078c46c13d85e34072b 100644 --- a/R/ValuationTables_Germany_LifeInsurance.R +++ b/R/ValuationTables_Germany_LifeInsurance.R @@ -19,26 +19,26 @@ dav1994T.data=read.xls( "qy2", "qyKI", "qy" )); -dav1994t.male=valuationTable.period( +DAV1994T.male=valuationTable.period( name="DAV 1994T male, loaded", ages=dav1994T.data$age, deathProbs=dav1994T.data$qx) -dav1994t.male.2Ord=valuationTable.period( +DAV1994T.male.2Ord=valuationTable.period( name="DAV 1994T male, unloaded", ages=dav1994T.data$age, deathProbs=dav1994T.data$qx2) -dav1994t.female=valuationTable.period( +DAV1994T.female=valuationTable.period( name="DAV 1994T female, loaded", ages=dav1994T.data$age, deathProbs=dav1994T.data$qy) -dav1994t.female.2Ord=valuationTable.period( +DAV1994T.female.2Ord=valuationTable.period( name="DAV 1994T female, unloaded", ages=dav1994T.data$age, deathProbs=dav1994T.data$qy2) -rm(dav1994T.data) +rm(DAV1994T.data) ###################################################### ## DAV 2008T Aggregat / Smoker / Non-Smoker ###################################################### -dav2008T.data=read.xls( +DAV2008T.data=read.xls( "Tafeln/DAV_T.xls", sheet=2, skip=2, #row.names=1, col.names=c("age", "", "", "", @@ -50,45 +50,45 @@ dav2008T.data=read.xls( )); ### DAV 2008T Aggregat (smoker+non-smoker combined) -dav2008t.male=valuationTable.period( +DAV2008T.male=valuationTable.period( name="DAV 2008T male, loaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qx1) -dav2008t.male.2Ord=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qx1) +DAV2008T.male.2Ord=valuationTable.period( name="DAV 2008T male, unloaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qx2) -dav2008t.female=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qx2) +DAV2008T.female=valuationTable.period( name="DAV 2008T female, loaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qy1) -dav2008t.female.2Ord=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qy1) +DAV2008T.female.2Ord=valuationTable.period( name="DAV 2008T female, unloaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qy2) + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qy2) ### DAV 2008T Smoker -dav2008t.male.smoker=valuationTable.period( +DAV2008T.male.smoker=valuationTable.period( name="DAV 2008T male smoker, loaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qx1R) -dav2008t.male.smoker.2Ord=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qx1R) +DAV2008T.male.smoker.2Ord=valuationTable.period( name="DAV 2008T male smoker, unloaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qx2R) -dav2008t.female.smoker=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qx2R) +DAV2008T.female.smoker=valuationTable.period( name="DAV 2008T female smoker, loaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qy1R) -dav2008t.female.smoker.2Ord=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qy1R) +DAV2008T.female.smoker.2Ord=valuationTable.period( name="DAV 2008T female smoker, unloaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qy2R) + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qy2R) ### DAV 2008T Non-Smoker -dav2008t.male.nonsmoker=valuationTable.period( +DAV2008T.male.nonsmoker=valuationTable.period( name="DAV 2008T male non-smoker, loaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qx1NR) -dav2008t.male.nonsmoker.2Ord=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qx1NR) +DAV2008T.male.nonsmoker.2Ord=valuationTable.period( name="DAV 2008T male non-smoker, unloaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qx2NR) -dav2008t.female.nonsmoker=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qx2NR) +DAV2008T.female.nonsmoker=valuationTable.period( name="DAV 2008T female non-smoker, loaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qy1NR) -dav2008t.female.nonsmoker.2Ord=valuationTable.period( + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qy1NR) +DAV2008T.female.nonsmoker.2Ord=valuationTable.period( name="DAV 2008T female non-smoker, unloaded", - ages=dav2008T.data$age, deathProbs=dav2008T.data$qy2NR) + ages=DAV2008T.data$age, deathProbs=DAV2008T.data$qy2NR) -rm(dav2008T.data); +rm(DAV2008T.data); diff --git a/Tafeln/AVOe_R.xls b/Tafeln/AVOe_R.xls deleted file mode 100644 index 3518b2676801a42cc8c64b1a82e6992a108287c3..0000000000000000000000000000000000000000 Binary files a/Tafeln/AVOe_R.xls and /dev/null differ