...
 
Commits (3)
......@@ -23,7 +23,6 @@ fitExtrapolationLaw = function(data, ages, data.ages = ages, Dx = NULL, Ex = NUL
weights = rep(0, length(neededAges))
names(weights) = neededAges
if (!is.null(fadeIn)) {
weights[neededAges < min(fadeIn)] = 0
fadeInLen = length(fadeIn);
......@@ -121,6 +120,8 @@ mT.fillAges = function(table, neededAges, fill = 0) {
table@loading = fillAges(table@loading, givenAges = existingAges, neededAges = neededAges, fill = 0)
if (!is.null(table@data$deaths))
table@data$deaths = fillAges(table@data$deaths, givenAges = existingAges, neededAges = neededAges, fill = 0)
if (!is.null(table@data$rawProbs))
table@data$rawProbs = fillAges(table@data$rawProbs, givenAges = existingAges, neededAges = neededAges, fill = 0)
table
}
......@@ -248,10 +249,9 @@ mT.extrapolateProbsExp = function(table, age, up = TRUE) {
#' @export
mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP",
fit = 75:99, extrapolate = 80:120,
fadeIn = 80:90, fadeOut = NULL) {
fadeIn = 80:90, fadeOut = NULL, raw = NULL) {
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable.")
ages = ages(table)
# if (!is.null(table@exposures) && !is.na(table@exposures)) {
# Ex = table@exposures
......@@ -266,10 +266,17 @@ mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP",
# Dx = table@deathProbs
# qx = table@deathProbs
# }
if (!is.null(raw)) {
rawData = raw
} else if (!is.null(table@data$rawProbs)) {
rawData = table@data$rawProbs
} else {
rawData = table@deathProbs
}
table = mT.fillAges(table, neededAges = union(ages, extrapolate), fill = 0)
fitted = fitExtrapolationLaw(
data = table@deathProbs, ages = ages(table),
qx = table@deathProbs, data.ages = ages,
qx = rawData, data.ages = ages,
method = method, law = law,
fit = fit, extrapolate = extrapolate,
fadeIn = fadeIn, fadeOut = fadeOut,
......@@ -327,6 +334,28 @@ pT.getSubTable = function(table, subtable = "qx") {
NULL
}
#' @export
mT.switchover = function(table, to, at, weights = NULL) {
if (is.array(table)) {
return(array(
lapply(table, mT.switchover, to = to, at = at, weights = weights),
dim = dim(table), dimnames = dimnames(table))
)
} else if (is.list(table)) {
return(lapply(table, mT.switchover, to = to, at = at, weights = weights))
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
if (is.null(weights)) {
ags.table = ages(table)
ags.to = ages(to)
weights = 1 * (ags.to >= at)
}
table@deathProbs = table@deathProbs * (1 - weights) + to@deathProbs * weights
table
}
#' @exportMethod mT.round
......