Commit e75d86ac authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Add whittaker.mortalityTable function, add exposures slot to mortalityTable.period

parent d3bbae41
......@@ -60,4 +60,5 @@ Collate:
'setLoading.R'
'setModification.R'
'undampenTrend.R'
'whittaker.mortalityTable.R'
VignetteBuilder: knitr
......@@ -27,6 +27,7 @@ export(periodDeathProbabilitiesIndividual)
export(plotMortalityTableComparisons)
export(plotMortalityTables)
export(plotMortalityTrend)
export(whittaker.mortalityTable)
exportClasses(mortalityTable)
exportClasses(mortalityTable.MakehamGompertz)
exportClasses(mortalityTable.Weibull)
......
......@@ -9,6 +9,8 @@ NULL
#'
#' @slot ages The ages corresponding to the entries of the deathProbs
#' @slot deathProbs The one-year death probabilities for the ages
#' @slot exposures (Optional) exposured used to determine death probabilities
#' (can be used as weights for smoothing, for variances, etc.)
#'
#' @export mortalityTable.period
#' @exportClass mortalityTable.period
......@@ -16,11 +18,13 @@ mortalityTable.period = setClass(
"mortalityTable.period",
slots = list(
ages = "numeric",
deathProbs = "numeric"
deathProbs = "numeric",
exposures = "numeric"
),
prototype = list(
ages = eval(0:120),
deathProbs = rep(1,120)
deathProbs = rep(1,120),
exposures = NULL
),
contains = "mortalityTable"
)
......
#' Smooth a life table using the Whittaker-Henderson method, intepolation possibly missing values
#'
#' \code{whittaker.mortalityTable} uses the Whittaker-Henderson graduation method
#' to smooth a table of raw observed death probabilities, optionally using the
#' exposures stored in the table as weights (if no exposures are given, equal
#' weights are applied). All ages with a death probability of \code{NA} will be
#' interpolated in the Whittaker-Henderson method (see e.g. Lowrie)
#'
#' @param table Mortality table to be graduated. Must be an instance of a
#' \code{mortalityTable}-derived class.
#' @param lambda Smoothing parameter (default 10)
#' @param d order of differences (default 2)
#' @param name.postfix Postfix appended to the name of the graduated table
#' @param weights Vector of weights used for graduation. Entries with weight 0
#' will be interpolated. If not given, the exposures of the table
#' or equal weights are used.
#'
#' @param ... additional arguments (currently unused)
#' @param reference The reference table that determines the 100\% values.
#' If not given, the absolute mortality values are
#' compared and plotted on a log-linear scale.
#' @param trend If set to \code{TRUE}, the function \code{\link{plotMortalityTrend}}
#' is used to plot the trends of the given tables.
#'
#' @references
#' Walter B. Lowrie: An Extension of the Whittaker-Henderson Method of Graduation, Transactions of Society of Actuaries, 1982, Vol. 34, pp. 329--372
#'
#' @examples
#' # TODO
#'
#' @seealso \code{\link{whittaker}}
#'
#' @import scales
#' @export
whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ", smoothed", ..., weights = NULL) {
if (!is(table, "mortalityTable")) {
stop("Table object must be an instance of mortalityTable in whittaker.mortalityTable.")
}
# append the postfix to the table name to distinguish it from the original (raw) table
if (!is.null(name.postfix)) {
table@name = paste0(table@name, name.postfix)
}
probs = table@deathProbs
ages = table@ages
if (missing(weights) || is.null(weights)) {
if (is.na(table@exposures) || is.null(table@exposures)) {
weights = table@exposures
} else {
weights = rep(1, length(ages))
}
}
# Missing values are always interpolated, i.e. assigned weight 0:
weights = weights * is.na(probs)
probs.smooth = exp(whittaker.interpolate(log(probs[!NApos]), lambda = lambda, d = d, weights = weights))
table@deathProbs = probs.smooth
table
}
whittaker.interpolate = function(y, lambda = 1600, d = 2, weights = rep(1, length(y))) {
m <- length(y)
E <- eye(m)
W <- diag(weights)
D <- diff(E, lag = 1, differences = d)# - r * diff(E, lab = 1, differences = d - 1)
B <- W + (lambda * t(D) %*% D)
z <- solve(B, W %*% y)
return(z)
}
#
# y = c(0.25288, 0, 0.31052, 0, 0, 0, 0.4062, 0, 0, 0, 0, 0.65162)
# weights = c(2115646, 0, 3413643, 0, 0, 0, 2487602, 0, 0, 0, 0, 999053)
#
#
# whittaker.interpolate(y, lambda = 10, d = 2, weights = weights)
......@@ -16,5 +16,8 @@ information about the period.
\item{\code{ages}}{The ages corresponding to the entries of the deathProbs}
\item{\code{deathProbs}}{The one-year death probabilities for the ages}
\item{\code{exposures}}{(Optional) exposured used to determine death probabilities
(can be used as weights for smoothing, for variances, etc.)}
}}
......@@ -4,8 +4,9 @@
\alias{plotMortalityTableComparisons}
\title{Plot multiple mortality tables (life tables) in one plot, relative to a given reference table}
\usage{
plotMortalityTableComparisons(data, ..., xlim = NULL, ylim = NULL,
xlab = NULL, ylab = NULL, title = "", legend.position = c(0.9, 0.1),
plotMortalityTableComparisons(data, ..., ages = NULL, xlim = NULL,
ylim = NULL, xlab = NULL, ylab = NULL, title = "",
legend.position = c(0.9, 0.1), legend.justification = c(1, 0),
legend.key.width = unit(25, "mm"), reference = NULL)
}
\arguments{
......@@ -13,6 +14,8 @@ plotMortalityTableComparisons(data, ..., xlim = NULL, ylim = NULL,
\item{...}{Additional life tables to be plotted (if \code{data} is a \code{mortalityTable} object)}
\item{ages}{Plot only the given ages}
\item{xlim}{X-axis limitatation (as a two-element vector)}
\item{ylim}{Y-axis limitatation (as a two-element vector)}
......@@ -25,6 +28,8 @@ plotMortalityTableComparisons(data, ..., xlim = NULL, ylim = NULL,
\item{legend.position}{The position of the legend (default is \code{c(0.9,0.1)})}
\item{legend.justification}{The justification of the legend (default is \code{c(1,)})}
\item{legend.key.width}{The keywith of the lines in the legend (default is \code{unit(25,"mm")})}
\item{reference}{The reference table that determines the 100\% values. If not given, the first argument of \code{data} is used as reference table.}
......
......@@ -4,8 +4,8 @@
\alias{plotMortalityTables}
\title{Plot multiple mortality tables (life tables) in one plot}
\usage{
plotMortalityTables(data, ..., legend.title = "Sterbetafel", xlim = NULL,
ylim = NULL, xlab = NULL, ylab = NULL, title = "",
plotMortalityTables(data, ..., ages = NULL, legend.title = "Sterbetafel",
xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, title = "",
legend.position = c(0.9, 0.1), legend.justification = c(1, 0),
legend.key.width = unit(25, "mm"))
}
......@@ -14,6 +14,8 @@ plotMortalityTables(data, ..., legend.title = "Sterbetafel", xlim = NULL,
\item{...}{Additional life tables to be plotted (if \code{data} is a \code{mortalityTable} object)}
\item{ages}{Plot only the given ages}
\item{xlim}{X-axis limitatation (as a two-element vector)}
\item{ylim}{Y-axis limitatation (as a two-element vector)}
......@@ -26,6 +28,8 @@ plotMortalityTables(data, ..., legend.title = "Sterbetafel", xlim = NULL,
\item{legend.position}{The position of the legend (default is \code{c(0.9,0.1)})}
\item{legend.justification}{The justification of the legend (default is \code{c(1,)})}
\item{legend.key.width}{The keywith of the lines in the legend (default is \code{unit(25,"mm")})}
}
\description{
......
% Generated by roxygen2: do not edit by hand
% Please edit documentation in R/whittaker.mortalityTable.R
\name{whittaker.mortalityTable}
\alias{whittaker.mortalityTable}
\title{Smooth a life table using the Whittaker-Henderson method, intepolation possibly missing values}
\usage{
whittaker.mortalityTable(table, lambda = 10, d = 2,
name.postfix = ", smoothed", ..., weights = NULL)
}
\arguments{
\item{table}{Mortality table to be graduated. Must be an instance of a
\code{mortalityTable}-derived class.}
\item{lambda}{Smoothing parameter (default 10)}
\item{d}{order of differences (default 2)}
\item{name.postfix}{Postfix appended to the name of the graduated table}
\item{...}{additional arguments (currently unused)}
\item{weights}{Vector of weights used for graduation. Entries with weight 0
will be interpolated. If not given, the exposures of the table
or equal weights are used.}
\item{reference}{The reference table that determines the 100\% values.
If not given, the absolute mortality values are
compared and plotted on a log-linear scale.}
\item{trend}{If set to \code{TRUE}, the function \code{\link{plotMortalityTrend}}
is used to plot the trends of the given tables.}
}
\description{
\code{whittaker.mortalityTable} uses the Whittaker-Henderson graduation method
to smooth a table of raw observed death probabilities, optionally using the
exposures stored in the table as weights (if no exposures are given, equal
weights are applied). All ages with a death probability of \code{NA} will be
interpolated in the Whittaker-Henderson method (see e.g. Lowrie)
}
\examples{
# TODO
}
\references{
Walter B. Lowrie: An Extension of the Whittaker-Henderson Method of Graduation, Transactions of Society of Actuaries, 1982, Vol. 34, pp. 329--372
}
\seealso{
\code{\link{whittaker}}
}
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