Commit 91ce73d2 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Add functions for pension tables and other utility functions

- mortalityTable.zeroes: Generate a mortality table with all zero transition probabilities
- mortalityTable.once: Generates a (deterministic) mortality table with one transition at a given age
- pensionTables.list: Lists all pension tables (similar to mortalityTables.list)
- pensionTables.load: Load a provided pension table (similar to mortalityTables.load)
- transitionProbabilities: Obtain data.frame containing all transition probabilities for a pension table (given the YOB)
- anwartschaften: First attempt to calculate all "Anwartschaften" for a given pensionTable - WORK IN PROGRESS, NOT FINISHED
parent 8b0a6edd
......@@ -12,11 +12,15 @@ export(mortalityTable.joined)
export(mortalityTable.jointLives)
export(mortalityTable.mixed)
export(mortalityTable.observed)
export(mortalityTable.once)
export(mortalityTable.period)
export(mortalityTable.trendProjection)
export(mortalityTable.zeroes)
export(mortalityTables.list)
export(mortalityTables.load)
export(pensionTable)
export(pensionTables.list)
export(pensionTables.load)
export(plotMortalityTableComparisons)
export(plotMortalityTables)
exportClasses(mortalityTable)
......@@ -41,6 +45,7 @@ exportMethods(lifeTable)
exportMethods(periodDeathProbabilities)
exportMethods(setLoading)
exportMethods(setModification)
exportMethods(transitionProbabilities)
exportMethods(undampenTrend)
import(ggplot2)
import(methods)
......
......@@ -24,3 +24,28 @@ mortalityTable.period = setClass(
),
contains = "mortalityTable"
)
#' Generate a mortality table with all probabilities set to zero.
#'
#' @param name The name of the table
#' @param ages The ages of the table
#'
#' @export
mortalityTable.zeroes = function(name = "Zero mortality table", ages = 0:99) {
mortalityTable.period(name = name, ages = ages, deathProbs = ages * 0)
}
#' Generate a (deterministic) mortality table with only one probability set to 1 (for the given age)
#'
#' @param name The name of the table
#' @param ages The ages of the table
#'
#' @export
mortalityTable.once = function(transitionAge, name = "Deterministic mortality table", ages = 0:99) {
mortalityTable.period(
name = name,
ages = ages,
deathProbs = sapply(ages, function(x) { if (x == transitionAge) 1 else 0})
)
}
......@@ -6,10 +6,21 @@
#' directory. Defaults to the "MortalityTables" package.
#'
#' @export
mortalityTables.list = function(pattern = "*", package = "MortalityTables") {
mortalityTables.list = function(pattern = "*", package = "MortalityTables", prefix = "MortalityTables") {
filepath = system.file("extdata", package = package);
files = Sys.glob(file.path(filepath, paste("MortalityTables_", pattern, ".R", sep = "")))
gsub('^MortalityTables_(.*).R$', '\\1', basename(files))
files = Sys.glob(file.path(filepath, paste(prefix, "_", pattern, ".R", sep = "")))
gsub(paste('^', prefix, '_(.*).R$', sep = ""), '\\1', basename(files))
}
#' List all available sets of pension tables provided by the \link[MortalityTables]{MortalityTables-package} package
#' An existing pension table can then be loaded with \link{pensionTables.load}.
#'
#' @param pattern Restrict the results only to pension table sets that match the pattern (default: "*" to show all sets)
#' @param package The package that contains the desired dataset in its \code{extdata/}
#' directory. Defaults to the "MortalityTables" package.
#'
#' @export
pensionTables.list = function(pattern = "*", package = "MortalityTables") {
mortalityTables.list(pattern = pattern, package = package, prefix = "PensionTables")
}
......@@ -6,18 +6,19 @@
#' datasets matching the pattern will be loaded
#' @param package The package that contains the dataset in its \code{extdata/}
#' directory. Defaults to the "MortalityTables" package.
#' @param prefix The prefix for the data sets (default is "MortalityTables")
#'
#' @export
mortalityTables.load = function(dataset, wildcard=FALSE, package="MortalityTables") {
mortalityTables.load = function(dataset, wildcard = FALSE, package = "MortalityTables", prefix = "MortalityTables") {
if (wildcard) {
sets = mortalityTables.list(dataset, package = package);
sets = mortalityTables.list(dataset, package = package, prefix = prefix);
} else {
sets = c(dataset);
}
for (set in sets) {
sname = gsub("[^-A-Za-z0-9_.]", "", set);
message("Loading mortality table data set '", sname, "'");
filename = system.file("extdata", paste("MortalityTables_", sname, ".R", sep = ""), package = package);
message("Loading table dataset '", sname, "'");
filename = system.file("extdata", paste(prefix, "_", sname, ".R", sep = ""), package = package);
if (filename != "") {
sys.source(filename, envir = globalenv())
} else {
......@@ -25,3 +26,20 @@ mortalityTables.load = function(dataset, wildcard=FALSE, package="MortalityTable
}
}
}
#' Load a named set of pension tables provided by the \link{MortalityTables} package
#'
#' @param dataset The set of lifpensione tables to be loaded. A list of all available
#' data sets is provided by the function \code{\link{pensionTables.list}}.
#' @param wildcard Whether the dataset name contains wildcard. If TRUE, all
#' datasets matching the pattern will be loaded
#' @param package The package that contains the dataset in its \code{extdata/}
#' directory. Defaults to the "MortalityTables" package.
#'
#' @export
pensionTables.load = function(dataset, wildcard = FALSE, package = "MortalityTables") {
mortalityTables.load(dataset = dataset, wildcard = wildcard, package = package, prefix = "PensionTables")
}
......@@ -58,12 +58,72 @@ pensionTable = setClass(
contains = "mortalityTable"
)
#' Return all transition probabilities of the pension table
#'
#' @param object A pension table object (instance of a \code{\linkS4class{pensionTable}} class)
#' @param ... Currently unused
#' @param YOB Year of birth
#'
#' @examples
#' pensionTables.load("Austria_*", wildcard=TRUE)
#' transitionProbabilities(EttlPagler.male)
#'
#' @exportMethod transitionProbabilities
setGeneric("transitionProbabilities", function(object, ...) standardGeneric("transitionProbabilities"));
#' @describeIn baseTable Return the base table of the joint lives mortality table (returns the base table of the first table used for joint lives)
setMethod("transitionProbabilities", "pensionTable",
function(object, ..., YOB = 1982) {
x = ages(object@qx);
q = deathProbabilities(object@qx, ..., YOB = YOB);
i = deathProbabilities(object@ix, ..., YOB = YOB);
data.frame(x, q, i)
qi = deathProbabilities(object@qix, ..., YOB = YOB);
r = deathProbabilities(object@rx, ..., YOB = YOB);
ap = deathProbabilities(object@apx, ..., YOB = YOB);
api = deathProbabilities(object@apix, ..., YOB = YOB);
qp = deathProbabilities(object@qpx, ..., YOB = YOB);
h = deathProbabilities(object@hx, ..., YOB = YOB);
qw = deathProbabilities(object@qwy, ..., YOB = YOB);
yx = deathProbabilities(object@yx, ..., YOB = YOB);
qg = deathProbabilities(object@qgx, ..., YOB = YOB);
data.frame(x, q, i, qi, r, ap, api, qp, h, qw, yx, qg)
})
if (FALSE) {
epP = transitionProbabilities(EttlPagler.male, YOB = 1982)
avoe08p = transitionProbabilities(AVOe2008P.male, YOB = 1977)
}
setGeneric("anwartschaften", function(object, ...) standardGeneric("anwartschaften"));
setMethod("anwartschaften", "pensionTable",
function(object, ..., i = 0.03, YOB = 1982) {
probs = transitionProbabilities(object, ..., YOB);
anwartschaften(probs, ..., YOB)
}
);
bwRente = function(p, v) {
Reduce(function(pp, ax1) { 1 + pp * ax1 * v }, p, 0.0, right = TRUE, accumulate = TRUE)[-(length(p) + 1)];
}
setMethod("anwartschaften", "data.frame",
function(object, ..., i = 0.03) {
x = object$x;
v = 1 / (1 + i);
# Anwartschaft auf Witwenrente und Alterspension
# 1) Barwerte:
aa = bwRente(1.0 - object$q, v);
ai = bwRente(1. - object$qi - object$r, v);
ap = bwRente(1. - object$qp, v);
aw = bwRente(1. - object$qw, v);
data.frame(x, aa, ai, ap, aw)
}
)
if (FALSE) {
probs = transitionProbabilities(AVOe2008P.female, YOB = 1977)
an = anwartschaften(probs, YOB = 1977); an
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/baseTable.R, R/mortalityTable.jointLives.R
% Please edit documentation in R/baseTable.R, R/mortalityTable.jointLives.R,
% R/pensionTable.R
\docType{methods}
\name{baseTable}
\alias{baseTable}
\alias{baseTable,mortalityTable-method}
\alias{baseTable,mortalityTable.period-method}
\alias{baseTable,mortalityTable.jointLives-method}
\alias{transitionProbabilities,pensionTable-method}
\title{Return the base table of the life table}
\usage{
baseTable(object, ...)
......@@ -15,6 +17,8 @@ baseTable(object, ...)
\S4method{baseTable}{mortalityTable.period}(object, ...)
\S4method{baseTable}{mortalityTable.jointLives}(object, ...)
\S4method{transitionProbabilities}{pensionTable}(object, ..., YOB = 1982)
}
\arguments{
\item{object}{The life table object (class inherited from mortalityTable)}
......@@ -31,6 +35,8 @@ Return the base table of the life table
\item \code{mortalityTable.period}: Return the base table of the life table
\item \code{mortalityTable.jointLives}: Return the base table of the joint lives mortality table (returns the base table of the first table used for joint lives)
\item \code{pensionTable}: Return the base table of the joint lives mortality table (returns the base table of the first table used for joint lives)
}}
\examples{
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/mortalityTable.period.R
\name{mortalityTable.once}
\alias{mortalityTable.once}
\title{Generate a (deterministic) mortality table with only one probability set to 1 (for the given age)}
\usage{
mortalityTable.once(transitionAge, name = "Deterministic mortality table",
ages = 0:99)
}
\arguments{
\item{name}{The name of the table}
\item{ages}{The ages of the table}
}
\description{
Generate a (deterministic) mortality table with only one probability set to 1 (for the given age)
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/mortalityTable.period.R
\name{mortalityTable.zeroes}
\alias{mortalityTable.zeroes}
\title{Generate a mortality table with all probabilities set to zero.}
\usage{
mortalityTable.zeroes(name = "Zero mortality table", ages = 0:99)
}
\arguments{
\item{name}{The name of the table}
\item{ages}{The ages of the table}
}
\description{
Generate a mortality table with all probabilities set to zero.
}
......@@ -5,7 +5,8 @@
\title{List all available sets of life tables provided by the \link[MortalityTables]{MortalityTables-package} package
An existing life table can then be loaded with \link{mortalityTables.load}.}
\usage{
mortalityTables.list(pattern = "*", package = "MortalityTables")
mortalityTables.list(pattern = "*", package = "MortalityTables",
prefix = "MortalityTables")
}
\arguments{
\item{pattern}{Restrict the results only to life table sets that match the pattern (default: "*" to show all sets)}
......
......@@ -4,7 +4,8 @@
\alias{mortalityTables.load}
\title{Load a named set of mortality tables provided by the \link{MortalityTables} package}
\usage{
mortalityTables.load(dataset, wildcard = FALSE, package = "MortalityTables")
mortalityTables.load(dataset, wildcard = FALSE, package = "MortalityTables",
prefix = "MortalityTables")
}
\arguments{
\item{dataset}{The set of life tables to be loaded. A list of all available
......@@ -15,6 +16,8 @@ datasets matching the pattern will be loaded}
\item{package}{The package that contains the dataset in its \code{extdata/}
directory. Defaults to the "MortalityTables" package.}
\item{prefix}{The prefix for the data sets (default is "MortalityTables")}
}
\description{
Load a named set of mortality tables provided by the \link{MortalityTables} package
......
......@@ -20,13 +20,14 @@ transition probabilities. Possible states are:
Correspondingly, the following transition probabilities can be given:
* qxaa: death probability of actives (active -> dead)
* ix: invalidity probability (active -> incapacity)
* qxi: death probability of invaid (invalid -> dead)
* qix: death probability of invalid (invalid -> dead)
* rx: reactivation probability (incapacity -> active)
* apx: retirement probability (active -> retirement), typically 1 for a fixed age
* apx: retirement probability of invalids (invalid -> retirement), typically 0 or 1 for a fixed age
* qxApm: death probability of retired (retired -> dead)
* qpx: death probability of retired (retired -> dead)
* hx: probability of a widow at moment of death (dead -> widow), y(x) age differene
* qxw: death probability of widows/widowers
* qgx: death probability of total group (irrespective of state)
}
\section{Slots}{
......@@ -41,14 +42,16 @@ Correspondingly, the following transition probabilities can be given:
\item{\code{apx}}{Retirement probability of actives (derived from mortalityTable)}
\item{\code{apxi}}{Retirement probability of invalids (derived from mortalityTable)}
\item{\code{apix}}{Retirement probability of invalids (derived from mortalityTable)}
\item{\code{qxApm}}{Death probability of old age pensioners (derived from mortalityTable)}
\item{\code{qpx}}{Death probability of old age pensioners (derived from mortalityTable)}
\item{\code{hx}}{Probability of a widow at the moment of death (derived from mortalityTable)}
\item{\code{qxw}}{Death probability of widow(er)s (derived from mortality Table)}
\item{\code{qwy}}{Death probability of widow(er)s (derived from mortality Table)}
\item{\code{xy}}{Age difference of the widow to the deceased}
\item{\code{yx}}{Age difference of the widow to the deceased}
\item{\code{qgx}}{Death probability of whole group (derived from mortalityTable), irrespective of state}
}}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/mortalityTables.list.R
\name{pensionTables.list}
\alias{pensionTables.list}
\title{List all available sets of pension tables provided by the \link[MortalityTables]{MortalityTables-package} package
An existing pension table can then be loaded with \link{pensionTables.load}.}
\usage{
pensionTables.list(pattern = "*", package = "MortalityTables")
}
\arguments{
\item{pattern}{Restrict the results only to pension table sets that match the pattern (default: "*" to show all sets)}
\item{package}{The package that contains the desired dataset in its \code{extdata/}
directory. Defaults to the "MortalityTables" package.}
}
\description{
List all available sets of pension tables provided by the \link[MortalityTables]{MortalityTables-package} package
An existing pension table can then be loaded with \link{pensionTables.load}.
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/mortalityTables.load.R
\name{pensionTables.load}
\alias{pensionTables.load}
\title{Load a named set of pension tables provided by the \link{MortalityTables} package}
\usage{
pensionTables.load(dataset, wildcard = FALSE, package = "MortalityTables")
}
\arguments{
\item{dataset}{The set of lifpensione tables to be loaded. A list of all available
data sets is provided by the function \code{\link{pensionTables.list}}.}
\item{wildcard}{Whether the dataset name contains wildcard. If TRUE, all
datasets matching the pattern will be loaded}
\item{package}{The package that contains the dataset in its \code{extdata/}
directory. Defaults to the "MortalityTables" package.}
}
\description{
Load a named set of pension tables provided by the \link{MortalityTables} package
}
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/pensionTable.R
\name{transitionProbabilities}
\alias{transitionProbabilities}
\title{Return all transition probabilities of the pension table}
\usage{
transitionProbabilities(object, ...)
}
\arguments{
\item{object}{A pension table object (instance of a \code{\linkS4class{pensionTable}} class)}
\item{...}{Currently unused}
\item{YOB}{Year of birth}
}
\description{
Return all transition probabilities of the pension table
}
\examples{
pensionTables.load("Austria_*", wildcard=TRUE)
transitionProbabilities(EttlPagler.male)
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment