Commit 3c64a96b authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Properly handle NA values in all utility functions

-) Handle NA values in all utility functions
-) Provide AT population forecast as array
-) Fix AVOe1999-R
parent 3613efd5
......@@ -98,6 +98,8 @@ mT.setName = function(table, name) {
)
} else if (is.list(table)) {
return(lapply(table, mT.setName, name = name))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -128,6 +130,8 @@ mT.fillAges = function(table, neededAges, fill = 0) {
)
} else if (is.list(table)) {
return(lapply(table, mT.fillAges, neededAges = neededAges, fill = fill))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -172,6 +176,8 @@ mT.scaleProbs = function(table, factor = 1.0, name.postfix = "scaled", name = NU
)
} else if (is.list(table)) {
return(lapply(table, mT.scaleProbs, factor = factor, name.postfix = name.postfix, name = name))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -206,6 +212,8 @@ mT.setTrend = function(table, trend, trendages = NULL, baseYear = NULL, dampingF
)
} else if (is.list(table)) {
return(lapply(table, mT.setTrend, trend = trend, trendages = trendages, baseYear = baseYear, dampingFunction = dampingFunction))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -233,6 +241,8 @@ mT.extrapolateTrendExp = function(table, idx, up = TRUE) {
)
} else if (is.list(table)) {
return(lapply(table, mT.extrapolateTrendExp, idx = idx, up = up))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -254,6 +264,8 @@ mT.translate = function(table, baseYear, name = NULL) {
)
} else if (is.list(table)) {
return(lapply(table, mT.translate, baseYear = baseYear, name = name))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -276,6 +288,8 @@ mT.extrapolateProbsExp = function(table, age, up = TRUE) {
)
} else if (is.list(table)) {
return(lapply(table, mT.extrapolateProbsExp, age = age, up = up))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -348,6 +362,8 @@ pT.setDimInfo = function(table, ..., append = TRUE) {
)
} else if (is.list(table)) {
return(lapply(table, pT.setDimInfo, ..., append = append))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "pensionTable"))
stop("First argument must be a pensionTable or a list of pensionTable objects.")
......@@ -382,6 +398,8 @@ mT.setDimInfo = function(table, ..., append = TRUE) {
return(lapply(table, mT.setDimInfo, ..., append = append))
} else if (is(table, "pensionTable")) {
return(pT.setDimInfo(table, ..., append = append))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
......@@ -405,6 +423,8 @@ pT.getSubTable = function(table, subtable = "qx") {
)
} else if (is.list(table)) {
return(lapply(table, pT.getSubTable, subtable = subtable))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "pensionTable"))
stop("First argument must be a pensionTable or a list of pensionTable objects.")
......@@ -428,6 +448,8 @@ mT.switchover = function(table, to, at, weights = NULL) {
)
} else if (is.list(table)) {
return(lapply(table, mT.switchover, to = to, at = at, weights = weights))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -581,6 +603,8 @@ pT.recalculateTotalMortality = function(object, ...) {
)
} else if (is.list(table)) {
return(lapply(table, pT.recalculateTotalMortality, ...))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "pensionTable"))
stop("First argument must be a pensionTable or a list of pensionTable objects.")
......
......@@ -74,6 +74,8 @@ whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ",
)
} else if (is.list(table)) {
return(lapply(table, whittaker.mortalityTable, lambda = lambda, d = d, name.postfix = name.postfix, ..., weights = weights, log = log))
} else if (is.na(c(table))) {
return(table)
}
if (!is(table, "mortalityTable")) {
stop("Table object must be an instance (or list of instances) of mortalityTable in whittaker.mortalityTable.")
......
......@@ -95,7 +95,7 @@ AVOe1996R.female.av325 = mortalityTable.ageShift(
AVOe1996R = array(
data = c(mortalityTable.NA),
dim = c(2, 2, 2),
dim = c(2, 3),
dimnames = list(Geschlecht = c("m", "w"), Collar = c("Einzel", "Gruppe", "AV"))
)
......
......@@ -30,6 +30,17 @@ mort.AT.forecast.female = mortalityTable.trendProjection(
)
)
mort.AT.forecast = array(
data = c(mortalityTable.NA),
dim = c(2),
dimnames = list(Geschlecht = c("m", "w"))
)
mort.AT.forecast[["m"]] = mort.AT.forecast.male
mort.AT.forecast[["w"]] = mort.AT.forecast.female
rm(AT.pop.fc)
###############################################################################
......
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