From 1b1132395066140a4829b2811619b531b44c0ea0 Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Sat, 28 Jul 2018 19:34:05 +0200
Subject: [PATCH] Add pT.getSubTable to extract sub-tables of pensionTable
objects
---
NAMESPACE | 1 +
R/utilityFunctions.R | 19 +++++++++++++++++++
2 files changed, 20 insertions(+)
diff --git a/NAMESPACE b/NAMESPACE
index 703e734..baf7650 100644
--- a/NAMESPACE
+++ b/NAMESPACE
@@ -32,6 +32,7 @@ export(mortalityTable.trendProjection)
export(mortalityTable.zeroes)
export(mortalityTables.list)
export(mortalityTables.load)
+export(pT.getSubTable)
export(pensionTable)
export(pensionTables.list)
export(pensionTables.load)
diff --git a/R/utilityFunctions.R b/R/utilityFunctions.R
index bdfdd03..14831df 100644
--- a/R/utilityFunctions.R
+++ b/R/utilityFunctions.R
@@ -284,3 +284,22 @@ mT.setDimInfo = function(table, ..., append = TRUE) {
table
}
+
+#' @export
+pT.getSubTable = function(table, subtable = "qx") {
+ if (is.array(table)) {
+ return(array(
+ lapply(table, pT.getSubTable, subtable = subtable),
+ dim = dim(table), dimnames = dimnames(table))
+ )
+ } else if (is.list(table)) {
+ return(lapply(table, pT.getSubTable, subtable = subtable))
+ }
+ if (!is(table, "pensionTable"))
+ stop("First argument must be a pensionTable or a list of pensionTable objects.")
+
+ if (.hasSlot(table, subtable))
+ slot(table, subtable)
+ else
+ NULL
+}
--
GitLab