Skip to content
Snippets Groups Projects
Commit 6adc19d2 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer
Browse files

mT.setDimInfo: Rename first argument from "table" to "tbl" to allow using...

mT.setDimInfo: Rename first argument from "table" to "tbl" to allow using "table" as a dim info factor
parent c098522f
No related branches found
No related tags found
No related merge requests found
...@@ -354,63 +354,63 @@ mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP", ...@@ -354,63 +354,63 @@ mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP",
} }
#' @export #' @export
pT.setDimInfo = function(table, ..., append = TRUE) { pT.setDimInfo = function(tbl, ..., append = TRUE) {
if (is.array(table)) { if (is.array(tbl)) {
return(array( return(array(
lapply(table, pT.setDimInfo, ..., append = append), lapply(tbl, pT.setDimInfo, ..., append = append),
dim = dim(table), dimnames = dimnames(table)) dim = dim(tbl), dimnames = dimnames(tbl))
) )
} else if (is.list(table)) { } else if (is.list(tbl)) {
return(lapply(table, pT.setDimInfo, ..., append = append)) return(lapply(tbl, pT.setDimInfo, ..., append = append))
} else if (is.na(c(table))) { } else if (is.na(c(tbl))) {
return(table) return(tbl)
} }
if (!is(table, "pensionTable")) if (!is(tbl, "pensionTable"))
stop("First argument must be a pensionTable or a list of pensionTable objects.") stop("First argument must be a pensionTable or a list of pensionTable objects.")
if (append) { if (append) {
table@data[names(list(...))] = list(...) tbl@data[names(list(...))] = list(...)
} else { } else {
table@data = list(...) tbl@data = list(...)
} }
table@qx = mT.setDimInfo(table@qx, ..., append = append) tbl@qx = mT.setDimInfo(tbl@qx, ..., append = append)
table@ix = mT.setDimInfo(table@ix, ..., append = append) tbl@ix = mT.setDimInfo(tbl@ix, ..., append = append)
table@qix = mT.setDimInfo(table@qix, ..., append = append) tbl@qix = mT.setDimInfo(tbl@qix, ..., append = append)
table@rx = mT.setDimInfo(table@rx, ..., append = append) tbl@rx = mT.setDimInfo(tbl@rx, ..., append = append)
table@apx = mT.setDimInfo(table@apx, ..., append = append) tbl@apx = mT.setDimInfo(tbl@apx, ..., append = append)
table@qpx = mT.setDimInfo(table@qpx, ..., append = append) tbl@qpx = mT.setDimInfo(tbl@qpx, ..., append = append)
table@hx = mT.setDimInfo(table@hx, ..., append = append) tbl@hx = mT.setDimInfo(tbl@hx, ..., append = append)
table@qwy = mT.setDimInfo(table@qwy, ..., append = append) tbl@qwy = mT.setDimInfo(tbl@qwy, ..., append = append)
table@qgx = mT.setDimInfo(table@qgx, ..., append = append) tbl@qgx = mT.setDimInfo(tbl@qgx, ..., append = append)
table tbl
} }
#' @export #' @export
mT.setDimInfo = function(table, ..., append = TRUE) { mT.setDimInfo = function(tbl, ..., append = TRUE) {
if (is.array(table)) { if (is.array(tbl)) {
return(array( return(array(
lapply(table, mT.setDimInfo, ..., append = append), lapply(tbl, mT.setDimInfo, ..., append = append),
dim = dim(table), dimnames = dimnames(table)) dim = dim(tbl), dimnames = dimnames(tbl))
) )
} else if (is.list(table)) { } else if (is.list(tbl)) {
return(lapply(table, mT.setDimInfo, ..., append = append)) return(lapply(tbl, mT.setDimInfo, ..., append = append))
} else if (is(table, "pensionTable")) { } else if (is(tbl, "pensionTable")) {
return(pT.setDimInfo(table, ..., append = append)) return(pT.setDimInfo(tbl, ..., append = append))
} else if (is.na(c(table))) { } else if (is.na(c(tbl))) {
return(table) return(tbl)
} }
if (!is(table, "mortalityTable")) if (!is(tbl, "mortalityTable"))
stop("First argument must be a mortalityTable or a list of mortalityTable objects.") stop("First argument must be a mortalityTable or a list of mortalityTable objects.")
if (append) { if (append) {
table@data$dim[names(list(...))] = list(...) tbl@data$dim[names(list(...))] = list(...)
} else { } else {
table@data$dim = list(...) tbl@data$dim = list(...)
} }
table tbl
} }
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment