diff --git a/.gitignore b/.gitignore
index 807ea251739a053faee6d72fe9dc3ae80d80cc15..f681c2b69d80bfe19973abf84b6ea48353e155e5 100644
--- a/.gitignore
+++ b/.gitignore
@@ -1,3 +1,4 @@
.Rproj.user
.Rhistory
.RData
+.~lock.*#
diff --git a/R/InsuranceTarif.R b/R/InsuranceTarif.R
index 3079f3c1833b43e3300c13978ba0ceb3bc896f24..7f2c77b03bf366d2e035a51b19455386cfcff0c4 100644
--- a/R/InsuranceTarif.R
+++ b/R/InsuranceTarif.R
@@ -1,63 +1,147 @@
-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",
+library(R6);
+library("lifecontingencies")
+
+
+# base class for Insurance Tarifs (holding contrat-independent values and
+# providing methods to calculate cash flows, premiums, etc.). Objects of this
+# class do NOT contain contract-specific values like age, death probabilities,
+# premiums, reserves, etc.
+InsuranceTarif = R6Class(
+ "InsuranceTarif",
+ public = list(
+ name = "Insurance Contract Type",
+ tarif = "Generic Tarif",
+ desc = "Description of the contract",
+ states = c("Lebend", "Tot"),
+ mortalityTable = NA,
+ interest=0,
+
+ initialize = function (name=NA, mortalityTable=NA, interest=NA,...) {
+ if (!missing(name)) self$name = name;
+ if (!missing(mortalityTable)) self$mortalityTable = mortalityTable;
+ if (!missing(interest)) self$interest = interest;
+ cat(paste0("Initializing Insurance Tarif ", self$name, "...\n"))
+ },
+ getTransitionProbabilities = function (age, ..., YOB=2000) {
+ ages = ages(self$mortalityTable, YOB=YOB);
+ q = deathProbabilities(self$mortalityTable, YOB=YOB);
+ if (age>0) {
+ ages = ages[-age:-1];
+ q = q[-age:-1];
+ }
+ p = 1-q;
+ len = length(p);
+ df=data.frame(p, q, rep(0,len), rep(1,len), row.names=ages)
+ df
+ },
+ getCashFlowsState = function (age, ..., policyPeriod=inf, deferral=0, maxAge=150) {
+ cf = list()
+ # TODO
+ },
+ getCashFlowsTransition = function (age, ..., policyPeriod=inf, deferral=0, maxAge=150) {
+ # TODO
+ }
+ )
+);
+
+TestTarif = InsuranceTarif$new(name="Testtarif", mortalityTable=AVOe2005R.male)
+str(TestTarif)
+TestTarif$getTransitionProbabilities(YOB=1980, age=30)
+
+
+InsuranceContract = R6Class(
+ "InsuranceContract",
+ public = list(
+ tarif = NA,
+ YOB = NA,
+ age = NA,
+ policyPeriod = inf,
+ deferral = 0,
- unterjährigkeit="numeric",
- unterjährigkeitsapproximation="numeric",
- cache.uj="list"
+ transitionProbabilities = NA,
+ cashFlowsState = NA,
+ cashFlowsTransition = NA,
+ # cashFlowsState = list(c(0), c(0)),
+ # cashFlowsTransition = list(matrix(c(0,1,0,1), 2, 2, byrow=TRUE)),
+ initialize = function (tarif, age, policyPeriod=inf, ..., deferral=0, YOB=1975) {
+ if (!missing(tarif)) self$tarif = tarif;
+ if (!missing(age)) self$age = age;
+ if (!missing(YOB)) self$YOB = YOB;
+ if (!missing(deferral)) self$deferral = deferral;
+ if (!missing(policyPeriod)) self$policyPeriod = policyPeriod;
+ self$determineTransitionProbabilities();
+ self$determineCashFlows();
+ },
- ),
- 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,
+ determineTransitionProbabilities = function() {
+ self$transitionProbabilities = self$tarif$getTransitionProbabilities(self$age, self$YOB);
+ },
- interest=0,
+ determineCashFlows = function() {
+ self$cashFlowsState = self$tarif$getCashFlowsState(age=self$age, YOB=self$YOB, policyPeriod=self$policyPeriod, deferral=self$deferral, maxAge=self$age+length(self$transitionProbabilities));
+ self$cashFlowsTransition = self$tarif$getCashFlowsState(age=self$age, YOB=self$YOB, policyPeriod=self$policyPeriod, deferral=self$deferral, maxAge=self$age+length(self$transitionProbabilities));
+
+ }
- deathPayments=list(),
- survivalPayments=list(),
- costCashflows=data.frame(),
- cashflows=data.frame(),
- probabilities=data.frame(),
- unterjährigkeit=1,
- unterjährigkeitsapproximation=1
+
+
)
);
+setGeneric("setYOB", function(scale, ...) standardGeneric("setYOB"));
+setMethod("setYOB", "InsuranceScale",
+ function (scale, ..., YOB=1975) {
+ scale@YOB=YOB;
+ scale
+ }
+)
+
+setGeneric("getTransitionProbabilities", function(scale, ...) standardGeneric("getTransitionProbabilities"));
+setMethod("getTransitionProbabilities", "InsuranceScale",
+ function (scale, ...) {
+ q = deathProbabilities(scale@mortalityTable, scale@YOB);
+ p = 1-q;
+ len = length(p);
+ df=data.frame(p, q, rep(0,len), rep(1,len), row.names=ages(scale@mortalityTable, scale@YOB))
+ }
+)
+
+
+setGeneric("calculateTransitionProbabilities", function(scale, ...) standardGeneric("calculateTransitionProbabilities"));
+setMethod("calculateTransitionProbabilities", "InsuranceScale",
+ function (scale, ...) {
+ scale@transitionProbabilities = getTransitionProbabilities(scale, ...);
+ scale
+ }
+)
+
+TestTarif = InsuranceScale(name="Testtarif", YOB=1980, age=30)
+#TestTarif = setYOB(TestTarif, YOB=1980)
+
+getTransitionProbabilities(TestTarif)
+
+t=AVOe2005R.unisex
+t@ages
+t@deathProbs
+qqq
+qqq["1",]
+
+mort=deathProbabilities(AVOe2005R.male, YOB=1977); mort
+
+mort=deathProbabilities(AVOe2005R.unisex, YOB=1977); mort
+q=mort
+p=1-mort; p
+len=length(p); len
+qqq=data.frame(q=t@deathProbs, row.names=t@ages); qqq
+
+df=data.frame("A-A"=p, "A-t"=q, "t-A"=rep(0, len), "t-t"=rep(1, len), row.names=t@ages)
+df
+
+
+
# createCostStructure=function(age=35,contractLength=inf,
# alphaVS,
# alphaBP,
diff --git a/R/S4classes.R b/R/S4classes.R
index 69ff3b12720942e538a66171a9869f198c6fd1c0..e69de29bb2d1d6434b8b29ae775ad8c2e48c5391 100644
--- a/R/S4classes.R
+++ b/R/S4classes.R
@@ -1,188 +0,0 @@
-library("lifecontingencies");
-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),
- 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"
-);
-# 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"
-);
-
-
-
-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) {}
-# TODO
- qx
- })
-setMethod("deathProbabilities","valuationTable.trendProjection",
- function (object, ..., YOB=1975) {
- qx=object@deathProbs;
- 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 {
- # 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, ...) {
- qx=deathProbabilities(object, ...);
- if (qx[[length(qx)]]!=1) { qx=c(qx, 1, 1); }
- probs2lifetable(qx, type="qx")
- })
-
-
-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/ValuationTables.R b/R/ValuationTables.R
index 5dd2ca94d4edf808304d355d36f9ec7fcc681001..3615bb98a720bd3ef8a970ead671fb0b4339d357 100644
--- a/R/ValuationTables.R
+++ b/R/ValuationTables.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"
+);
@@ -76,6 +84,13 @@ setMethod("getOmega", "valuationTable.period",
max(object@ages,na.rm=TRUE);
})
+setGeneric("ages", function(object, ...) standardGeneric("ages"));
+setMethod("ages", "valuationTable.period",
+ function (object, ...) {
+ object@ages;
+ })
+
+
setGeneric("deathProbabilities", function(object, ..., YOB=1975) standardGeneric("deathProbabilities"));
setMethod("deathProbabilities", "valuationTable.period",
function(object, ..., YOB=1975) {
@@ -86,27 +101,83 @@ setMethod("deathProbabilities","valuationTable.ageShift",
qx=object@deathProbs;
shift.index=match(YOB, object@shifts, 0);
if (shift.index) {}
- # shift=
+ # TODO
qx
})
setMethod("deathProbabilities","valuationTable.trendProjection",
function (object, ..., YOB=1975) {
+cat("deathProbabilities for valuationTable.trendProjection, YOB=", YOB, "\n")
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
+ 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 {
# 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("periodDeathProbabilities", function(object, ...) standardGeneric("periodDeathProbabilities"));
+setMethod("periodDeathProbabilities", "valuationTable.period",
+ function(object, ...) {
+ object@deathProbs;
+ })
+setMethod("periodDeathProbabilities","valuationTable.ageShift",
+ function (object, ..., Period=1975) {
+ # TODO
+ qx=object@deathProbs;
+ shift.index=match(YOB, object@shifts, 0);
+ if (shift.index) {}
+ # TODO
+ qx
+ })
+setMethod("periodDeathProbabilities","valuationTable.trendProjection",
+ function (object, ..., Period=1975) {
+ qx=object@deathProbs;
+ if (is.null(object@trend2) || length(object@trend2)<=1) {
+ ages=0:(length(qx)-1);
+ 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,]);
+ exp(-object@trend*damping)*qx;
+ } else {
+ # TODO
+ # 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("periodDeathProbabilities","valuationTable.improvementFactors",
+ function (object, ..., Period=1975) {
+ qx=object@deathProbs;
+ (1-object@improvement)^(Period-object@baseYear)*qx
+ })
+setMethod("periodDeathProbabilities","valuationTable.mixed",
+ function (object, ..., Period=1975) {
+ qx1=periodDeathProbabilities(object@table1, ..., Period=Period);
+ qx2=periodDeathProbabilities(object@table2, ..., Period=Period);
+ (object@weight1*qx1 + object@weight2*qx2)/(object@weight1 + object@weight2)
+ })
+
+
+
+
setGeneric("lifeTable", function(object, ...) standardGeneric("lifeTable"));
setMethod("lifeTable","valuationTable",
function (object, ...) {
@@ -116,3 +187,107 @@ 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
+ })
+
+
+setGeneric("getPeriodTable", function(object, Period, ...) standardGeneric("getPeriodTable"));
+setMethod("getPeriodTable","valuationTable",
+ function (object, Period, ...) {
+ valuationTable.period(
+ name = paste(object@name, ", Period ", Period),
+ baseYear = Period,
+ ages = ages(object),
+ deathProbs = periodDeathProbabilities(object, Period=Period)
+ )
+ })
+
+setGeneric("getCohortTable", function(object, Period, ...) standardGeneric("getCohortTable"));
+setMethod("getCohortTable","valuationTable",
+ function (object, YOB, ...) {
+ valuationTable.period(
+ name = paste(object@name, ", YOB ", YOB),
+ baseYear = YOB,
+ ages=ages(object),
+ deathProbs=deathProbabilities(object, YOB=YOB)
+ );
+ })
+
+
+
+makeQxDataFrame = function(..., YOB=1972, Period=NA) {
+ data=list(...);
+ names(data) = lapply(data, function(t) t@name);
+ if (missing(Period)) {
+ cat("Year of birth: ", YOB, "\n");
+ data = lapply(data, function(t) cbind(x=t@ages, y=deathProbabilities(t, YOB=YOB)))
+ } else {
+ 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))
+ data$group <- rep(list.names, lns)
+ data
+}
+
+plotValuationTables = function(..., title = "", legend.position=c(0.9,0.1), legend.key.width = unit(25, "mm")) {
+ 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"),
+ # legend in bottom right corner of the plot
+ legend.justification=c(1,0), legend.position=legend.position,
+ # No box around legend entries
+ legend.key = element_blank(),
+ legend.key.width = legend.key.width,
+ legend.background = element_rect(colour="gray50", linetype="solid")
+ ) +
+ geom_line() +
+ scale_y_log10(
+ name=expression(paste("Sterbewahrscheinlichkeit ", q[x])),
+ breaks = scales::trans_breaks('log10', function(x) 10^x),
+ labels = scales::trans_format('log10', scales::math_format(10^.x))
+ #minor_breaks = log(c(sapply(x, function(x) seq(0, x, x/10))), 10)
+ ) +
+ scale_x_continuous(
+ name="Alter",
+ #breaks = function (limits) scales::trans_breaks('', function(x) 10^x),
+ 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");
+ if (title != "") {
+ pl = pl + ggtitle(title);
+ }
+ 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")
+
+plotValuationTables(mort.AT.census.2001.male, AVOe2005R.male, YOB=1972, title="Vergleich österreichische Sterbetafeln")
+plotValuationTables(getCohortTable(AVOe2005R.male, YOB=1972), getCohortTable(AVOe2005R.male, YOB=2016), title="Vergleich österreichische Sterbetafeln")
diff --git a/R/ValuationTables_Austria_Annuities.R b/R/ValuationTables_Austria_Annuities.R
index 3b6f19296b42d29f2959af0e810100811cf94bbd..c4385c7af8351fd3d888ecf593e214a44177f685 100644
--- a/R/ValuationTables_Austria_Annuities.R
+++ b/R/ValuationTables_Austria_Annuities.R
@@ -218,3 +218,6 @@ AVOe2005R.unisex.group.av=AVOe2005R_gen.av("AVÖ 2005R unisex group (age-shifted
###############################################################################
+
+t=AVOe2005R.male;
+deathProbabilities(t, YOB=2001)
diff --git a/R/ValuationTables_Austria_Census.R b/R/ValuationTables_Austria_Census.R
index 7096d1a5d26a23bbfc190703014197651afc0a36..31e2a655fe7045ee1eac046a13e0a3f62699ecb8 100644
--- a/R/ValuationTables_Austria_Census.R
+++ b/R/ValuationTables_Austria_Census.R
@@ -109,3 +109,31 @@ ggplot(mort.AT.census.ALL.maleA, aes(x = x, y = y, colour = mort.AT.census.ALL.m
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")
+
+plotValuationTables(
+ #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.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, title="Vergleich österreichische Sterbetafeln", legend.position=c(1,0))
\ No newline at end of file
diff --git a/R/ValuationTables_Germany_Annuities.R b/R/ValuationTables_Germany_Annuities.R
index 13c2cf014002a3efd87415596b79935d75cf91b0..d5f94d8edf4b5f732b6e10e6a2ad33b3a45ba031 100644
--- a/R/ValuationTables_Germany_Annuities.R
+++ b/R/ValuationTables_Germany_Annuities.R
@@ -86,6 +86,6 @@ DAV2004R.male=valuationTable.trendProjection(
DAV2004R.female=valuationTable.trendProjection(
name="DAV 2004R female",
ages=DAV2004R.exakt.data$age, baseYear=2000,
- deathProbs=DAV2004R.exakt.data$qy2000,
+ deathProbs=DAV2004R.exakt.data $qy2000,
trend=DAV2004R.exakt.data$trendF
);
diff --git a/ValuationTables.RData b/ValuationTables.RData
new file mode 100644
index 0000000000000000000000000000000000000000..d31a25b2ec1d0efcb239727afb25ffa43101ca2b
Binary files /dev/null and b/ValuationTables.RData differ