diff --git a/NAMESPACE b/NAMESPACE index 395cf4e5102a1a85c779543d87b54fa6d53832a8..81049604e66853084f7a4646258f06107367378a 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -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) diff --git a/R/mortalityTable.period.R b/R/mortalityTable.period.R index b33b150b15fc64097de63bc407f93110a0770477..c1bf31aa18aac1060f1126f7d03333c72d5644cd 100644 --- a/R/mortalityTable.period.R +++ b/R/mortalityTable.period.R @@ -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}) + ) +} + diff --git a/R/mortalityTables.list.R b/R/mortalityTables.list.R index fc72a7581d48d161805f7614ebf91ad9497d9ed2..4728548bb444dba366dc17d825ef37ef71ce7807 100644 --- a/R/mortalityTables.list.R +++ b/R/mortalityTables.list.R @@ -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") +} diff --git a/R/mortalityTables.load.R b/R/mortalityTables.load.R index f0426dbc20e06e148cce6f76cb75b3e1d2cf8317..5d58ae47456b920907ddebe518de6e2addf316c2 100644 --- a/R/mortalityTables.load.R +++ b/R/mortalityTables.load.R @@ -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") +} + + diff --git a/R/pensionTable.R b/R/pensionTable.R index dcfec969e2e1a94e1481b7743afe9c77d8e1b842..5511b1daa5e9a6cb23abf3cdc97981efc1a802f9 100644 --- a/R/pensionTable.R +++ b/R/pensionTable.R @@ -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 +} diff --git a/man/baseTable.Rd b/man/baseTable.Rd index 98c35374d17b90aa96b5dbf937552d51190e593d..01f0f7fe0071f97338b36b3b35efbde35282134b 100644 --- a/man/baseTable.Rd +++ b/man/baseTable.Rd @@ -1,11 +1,13 @@ % 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{ diff --git a/man/mortalityTable.once.Rd b/man/mortalityTable.once.Rd new file mode 100644 index 0000000000000000000000000000000000000000..a73d8c317f05f8adea3fd15c89b5a1ae3bc91305 --- /dev/null +++ b/man/mortalityTable.once.Rd @@ -0,0 +1,17 @@ +% 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) +} diff --git a/man/mortalityTable.zeroes.Rd b/man/mortalityTable.zeroes.Rd new file mode 100644 index 0000000000000000000000000000000000000000..ec09db705182980399f3da160a0d597604864485 --- /dev/null +++ b/man/mortalityTable.zeroes.Rd @@ -0,0 +1,16 @@ +% 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. +} diff --git a/man/mortalityTables.list.Rd b/man/mortalityTables.list.Rd index cf1d1055771cdb99adac67744f6f3d652b1f5969..a57f52fce91bff1c0f8771deddaa799ea3ca5bab 100644 --- a/man/mortalityTables.list.Rd +++ b/man/mortalityTables.list.Rd @@ -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)} diff --git a/man/mortalityTables.load.Rd b/man/mortalityTables.load.Rd index f8ce268044a280d8f649e4bf146011b9f1807b3a..351535be183f17a7d0fcf0b6eef34380e6933f95 100644 --- a/man/mortalityTables.load.Rd +++ b/man/mortalityTables.load.Rd @@ -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 diff --git a/man/pensionTable-class.Rd b/man/pensionTable-class.Rd index 7a0eeb1564cb6871ee604e299c2af99d1903be49..6b8e0989d105586f64753b4207f1077a2e5ef061 100644 --- a/man/pensionTable-class.Rd +++ b/man/pensionTable-class.Rd @@ -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} }} diff --git a/man/pensionTables.list.Rd b/man/pensionTables.list.Rd new file mode 100644 index 0000000000000000000000000000000000000000..571fc9473bdedd581598f45e82d1a60cf0b5f623 --- /dev/null +++ b/man/pensionTables.list.Rd @@ -0,0 +1,19 @@ +% 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}. +} diff --git a/man/pensionTables.load.Rd b/man/pensionTables.load.Rd new file mode 100644 index 0000000000000000000000000000000000000000..32b9d127d358cf99d243eba085a07cafe4107d6f --- /dev/null +++ b/man/pensionTables.load.Rd @@ -0,0 +1,21 @@ +% 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 +} diff --git a/man/transitionProbabilities.Rd b/man/transitionProbabilities.Rd new file mode 100644 index 0000000000000000000000000000000000000000..843d3823b77076c65596fb7fd3b3c98d33d99576 --- /dev/null +++ b/man/transitionProbabilities.Rd @@ -0,0 +1,23 @@ +% 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) + +}