StMoMo {StMoMo} | R Documentation |
Create a new Stochastic Mortality Model
Description
Initialises a StMoMo object which represents a Generalised Age-Period-Cohort Stochastic Mortality Model.
StMoMo.
Usage
StMoMo(link = c("log", "logit"), staticAgeFun = TRUE, periodAgeFun = "NP",
cohortAgeFun = NULL, constFun = function(ax, bx, kt, b0x, gc, wxt, ages)
list(ax = ax, bx = bx, kt = kt, b0x = b0x, gc = gc))
Arguments
link |
defines the link function and random component associated with
the mortality model. |
staticAgeFun |
logical value indicating if a static age function
|
periodAgeFun |
a list of length |
cohortAgeFun |
defines the cohort age modulating parameter
|
constFun |
function defining the identifiability constraints of the
model. It must be a function of the form
|
Details
R implementation of the family of Generalised Age-Period-Cohort stochastic mortality models. This family of models encompasses many models proposed in the literature including the well-known Lee-Carter model, CBD model and APC model.
StMoMo
defines an abstract representation of a Generalised
Age-Period-Cohort (GAPC) Stochastic model that fits within the
general class of generalised non-linear models defined as follows
D_{xt} \sim Poisson(E_{xt}\mu_{xt}), D_{xt} \sim
Binomial(E_{xt},q_{xt})
\eta_{xt} = \log \mu_{xt}, \eta_{xt} = \mathrm{logit}\,
q_{xt}
\eta_{xt} = \alpha_x + \sum_{i=1}^N \beta_x^{(i)}\kappa_t^{(i)}
+ \beta_x^{(0)}\gamma_{t-x}
v: \{\alpha_{x}, \beta_x^{(1)},...,
\beta_x^{(N)}, \kappa_t^{(1)},..., \kappa_t^{(N)}, \beta_x^{(0)}, \gamma_{t-x}\} \mapsto
\{\alpha_{x}, \beta_x^{(1)},..., \beta_x^{(N)}, \kappa_t^{(1)},..., \kappa_t^{(N)},
\beta_x^{(0)}, \gamma_{t-x}\},
where
-
\alpha_x
is a static age function; -
\beta_x^{(i)}\kappa_t^{(i)}, i = 1,..N
, are age/period terms; -
\beta_x^{(0)}\gamma_{t-x}
is the age/cohort term; and -
v
is a function defining the identifiability constraints of the model.
Most Stochastic mortality models proposed in the literature can be cast to this representation (See Hunt and Blake (2015)).
Parametric age functions should be scalar functions of the form
f <- function(x, ages)
taking a scalar age x
and a vector
of model fitting ages
(see examples below).
Do to limitation of functions gnm
within package
gnm, which is used for fitting "StMoMo"
objects to data
(see fit.StMoMo
), models combining parametric and
non-parametric age-modulating functions are not supported at the moment.
Value
A list with class "StMoMo"
with components:
link |
a character string defining the link function of the model. |
staticAgeFun |
a logical value indicating if the model has a static age function. |
periodAgeFun |
a list defining the period age modulating parameters. |
cohortAgeFun |
an object defining the cohort age modulating parameters. |
constFun |
a function defining the identifiability constraints. |
N |
an integer specifying The number of age-period terms in the model. |
textFormula |
a character string of the model formula. |
gnmFormula |
a formula that can be used for fitting the model with package gnm. |
References
Plat, R. (2009). On stochastic mortality modeling. Insurance: Mathematics and Economics, 45(3), 393-404.
Hunt, A., & Blake, D. (2015). On the Structure and Classification of Mortality Models Mortality Models. Pension Institute Working Paper. http://www.pensions-institute.org/workingpapers/wp1506.pdf.
See Also
fit.StMoMo
, lc
, cbd
,
apc
, rh
, m6
, m7
,
m8
Examples
#Lee-Carter model
constLC <- function(ax, bx, kt, b0x, gc, wxt, ages) {
c1 <- mean(kt[1, ], na.rm = TRUE)
c2 <- sum(bx[, 1], na.rm = TRUE)
list(ax = ax + c1 * bx, bx = bx / c2, kt = c2 * (kt - c1))
}
LC <- StMoMo(link = "log", staticAgeFun = TRUE, periodAgeFun = "NP",
constFun = constLC)
plot(fit(LC, data = EWMaleData, ages.fit = 55:89))
#CBD model
f2 <- function(x, ages) x - mean(ages)
CBD <- StMoMo(link = "logit", staticAgeFun = FALSE,
periodAgeFun = c("1", f2))
plot(fit(CBD, data = EWMaleData, ages.fit = 55:89))
#Reduced Plat model (Plat, 2009)
f2 <- function(x, ages) mean(ages) - x
constPlat <- function(ax, bx, kt, b0x, gc, wxt, ages) {
nYears <- dim(wxt)[2]
x <- ages
t <- 1:nYears
c <- (1 - tail(ages, 1)):(nYears - ages[1])
xbar <- mean(x)
#nsum g(c)=0, nsum cg(c)=0, nsum c^2g(c)=0
phiReg <- lm(gc ~ 1 + c + I(c^2), na.action = na.omit)
phi <- coef(phiReg)
gc <- gc - phi[1] - phi[2] * c - phi[3] * c^2
kt[2, ] <- kt[2, ] + 2 * phi[3] * t
kt[1, ] <- kt[1, ] + phi[2] * t + phi[3] * (t^2 - 2 * xbar * t)
ax <- ax + phi[1] - phi[2] * x + phi[3] * x^2
#nsum kt[i, ] = 0
ci <- rowMeans(kt, na.rm = TRUE)
ax <- ax + ci[1] + ci[2] * (xbar - x)
kt[1, ] <- kt[1, ] - ci[1]
kt[2, ] <- kt[2, ] - ci[2]
list(ax = ax, bx = bx, kt = kt, b0x = b0x, gc = gc)
}
PLAT <- StMoMo(link = "log", staticAgeFun = TRUE,
periodAgeFun = c("1", f2), cohortAgeFun = "1",
constFun = constPlat)
plot(fit(PLAT, data = EWMaleData, ages.fit = 55:89))
#Models not supported
## Not run:
MnotSup1 <- StMoMo(periodAgeFun = c(f2, "NP"))
MnotSup1 <- StMoMo(periodAgeFun = f2, cohortAgeFun = "NP")
## End(Not run)