Commit cab5dffa authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

applying the mT.* utility functions to arrays of tables caused the dimensions...

applying the mT.* utility functions to arrays of tables caused the dimensions to disappear => add the dimensions back
parent 03b2c5e7
......@@ -76,8 +76,11 @@ fitExpExtrapolation = function(data, idx, up = TRUE, verbose = FALSE) {
#' @export
mT.setName = function(table, name = table@name) {
if (is.list(table)) {
return(lapply(table, mT.setName, name = name))
if (is.array(table)) {
return(array(
lapply(table, mT.setName, name = name),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -90,8 +93,11 @@ mT.setName = function(table, name = table@name) {
#' @export
mT.fillAges = function(table, neededAges, fill = 0) {
if (is.list(table)) {
return(lapply(table, mT.fillAges, neededAges = neededAges, fill = fill))
if (is.array(table)) {
return(array(
lapply(table, mT.fillAges, neededAges = neededAges, fill = fill),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -116,8 +122,11 @@ mT.fillAges = function(table, neededAges, fill = 0) {
#' @export
mT.scaleProbs = function(table, factor = 1.0, name.postfix = "scaled", name = paste(table@name, name.postfix)) {
if (is.list(table)) {
return(lapply(table, mT.scaleProbs, factor = factor, name.postfix = name.postfix, name = name))
if (is.array(table)) {
return(array(
lapply(table, mT.scaleProbs, factor = factor, name.postfix = name.postfix, name = name),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -132,8 +141,11 @@ mT.scaleProbs = function(table, factor = 1.0, name.postfix = "scaled", name = pa
#' @export
mT.setTrend = function(table, trend, trendages = ages(table), baseYear = table@baseYear, dampingFunction = identity) {
if (is.list(table)) {
return(lapply(table, mT.setTrend, trend = trend, trendages = trendages, baseYear = baseYear, dampingFunction = dampingFunction))
if (is.array(table)) {
return(array(
lapply(table, mT.setTrend, trend = trend, trendages = trendages, baseYear = baseYear, dampingFunction = dampingFunction),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -154,8 +166,11 @@ mT.addTrend = mT.setTrend
#' @export
mT.extrapolateTrendExp = function(table, idx, up = TRUE) {
if (is.list(table)) {
return(lapply(table, mT.extrapolateTrendExp, idx = idx, up = up))
if (is.array(table)) {
return(array(
lapply(table, mT.extrapolateTrendExp, idx = idx, up = up),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -170,8 +185,11 @@ mT.extrapolateTrendExp = function(table, idx, up = TRUE) {
#' @export
mT.translate = function(table, baseYear, name = table@name) {
if (is.list(table)) {
return(lapply(table, mT.translate, baseYear = baseYear, name = name))
if (is.array(table)) {
return(array(
lapply(table, mT.translate, baseYear = baseYear, name = name),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -185,8 +203,11 @@ mT.translate = function(table, baseYear, name = table@name) {
#' @export
mT.extrapolateProbsExp = function(table, age, up = TRUE) {
if (is.list(table)) {
return(lapply(table, mT.extrapolateProbsExp, age = age, up = up))
if (is.array(table)) {
return(array(
lapply(table, mT.extrapolateProbsExp, age = age, up = up),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......@@ -246,8 +267,11 @@ mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP",
#' @export
mT.setDimInfo = function(table, ..., append = TRUE) {
if (is.list(table)) {
return(lapply(table, mT.setDimInfo, ..., append = append))
if (is.array(table)) {
return(array(
lapply(table, mT.setDimInfo, ..., append = append),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
......
......@@ -67,8 +67,11 @@
#' @import scales
#' @export
whittaker.mortalityTable = function(table, lambda = 10, d = 2, name.postfix = ", smoothed", ..., weights = NULL, log = TRUE) {
if (is.list(table)) {
return(lapply(table, whittaker.mortalityTable, lambda = lambda, d = d, name.postfix = name.postfix, ..., weights = weights, log = log))
if (is.array(table)) {
return(array(
lapply(table, whittaker.mortalityTable, lambda = lambda, d = d, name.postfix = name.postfix, ..., weights = weights, log = log),
dim = dim(table), dimnames = dimnames(table))
)
}
if (!is(table, "mortalityTable")) {
stop("Table object must be an instance (or list of instances) of mortalityTable in whittaker.mortalityTable.")
......
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