Implement Pension table AVÖ 2008P

inst/extdata/PensionTables_Austria_AVOe1999P.R

@@ -3,11 +3,8 @@ NULL
 
 stopifnot(require(methods), require(utils), require(MortalityTables), require(readxl)) # MortalityTable classes; new; Excel reader
 
-# TODO:
-#  *) Arbeitsmarkteffekt
-
 ############################################################################### #
-# Pension Table AVÖ 2018-P                                                   ----
+# Pension Table AVÖ 1999P                                                   ----
 ############################################################################### #
 
 if (is.null(getOption("MortalityTables.AVOe1999P"))) {
@@ -16,9 +13,6 @@ if (is.null(getOption("MortalityTables.AVOe1999P"))) {
 
 
 
-###############################################################################
-# AVÖ 1999P exact (Male, Female)
-###############################################################################
 AVOe1999P.generate = function(tab, name="P", collar = "Angestellte") {
     table99 = function(name, data, agevar = "x", probvar, trendvar = NULL, dim = list(), ..., baseyear = 1982) {
         if (is.null(trendvar)) {

TODO/PensionTables_Austria_AVOe2008P.R → inst/extdata/PensionTables_Austria_AVOe2008P.R

 #' @import MortalityTables
 NULL
 
-stopifnot(require(methods), require(utils), require(MortalityTables)) # MortalityTable classes; new; Excel reader
+stopifnot(require(methods), require(utils), require(MortalityTables), require(readxl)) # MortalityTable classes; new; Excel reader
+
+###############################################################################
+# AVÖ 2008P exact (Male, Female)
+###############################################################################
+
+if (is.null(getOption("MortalityTables.AVOe2008P"))) {
+    message("The pension table AVÖ 1999P requires the Excel file 'Austria_Pensions_AVOe2008P.xlsx'. Please set its path with options(\"MortalityTables.AVOe2008P\" = \"/path/to/Austria_Pensions_AVOe2008P.xlsx\").")
+} else {
+
 
 my.natrim <- function(v, ...) {
     # Add a NA at the beginning and end, so the first and last entry of the rle
@@ -11,9 +20,6 @@ my.natrim <- function(v, ...) {
     tail(head(vv, -tail(r$lengths, 1)), -head(r$lengths, 1))
 }
 
-###############################################################################
-# AVÖ 2008P exact (Male, Female)
-###############################################################################
 
 
 #' Modification function to add certain loading or special effect ending at a given age.
@@ -52,15 +58,15 @@ modArbeitsmarkteffekt = function(effect, pensionAge = 65, ages = 0:100) {
     }
 }
 
-if (FALSE) {
-    mA = modArbeitsmarkteffekt(effect = 0:7/8, pensionAge = 30, ages = 10:20*2)
-    mA(10:20*2)
-    mA = modArbeitsmarkteffekt(effect = 0:7/8, pensionAge = 30, ages = 20:40)
-    mA(20:40)
-}
+# if (FALSE) {
+#     mA = modArbeitsmarkteffekt(effect = 0:7/8, pensionAge = 30, ages = 10:20*2)
+#     mA(10:20*2)
+#     mA = modArbeitsmarkteffekt(effect = 0:7/8, pensionAge = 30, ages = 20:40)
+#     mA(20:40)
+# }
 
 
-AVOe2008P.generate = function(file, name="P", collar = "Angestellte") {
+AVOe2008P.generate = function(tab, name = "P", collar = "Angestellte") {
     table08 = function(name, data, agevar = "x", probvar, trendvar = NULL, dim = list(), ..., baseyear = 1982) {
         if (is.null(trendvar)) {
             mortalityTable.period(
@@ -81,20 +87,20 @@ AVOe2008P.generate = function(file, name="P", collar = "Angestellte") {
         paste("AVÖ 2008-", name, ", ", desc, sep = "")
     }
 
-    data = utils::read.csv(
-        system.file("extdata", file, package = "MortalityTablesPrivate"),
-        skip = 4,
-        header = FALSE,
-        col.names = c(
-            "x",
-            "qaax", "qix", "qpx", "qgx", "qwy", "ix", "hx", "yx",
-            "SPACER",
-            "qaay", "qiy", "qpy", "qgy", "qwx", "iy", "hy", "xy",
-            "SPACER", "lambdax", "lambday",
-            "SPACER", "SPACER", "Arbeitsmarkt_M", "Arbeitsmarkt_F")
-        , colClasses = c(qpx = "numeric", qgx = "numeric", qpy = "numeric", qgy = "numeric")
+
+    data = read_excel(getOption("MortalityTables.AVOe2008P"), sheet = tab,
+    skip = 4,
+    col_names = c(
+        "x",
+        "qaax", "qix", "qpx", "qgx", "qwy", "ix", "hx", "yx",
+        "SPACER1",
+        "qaay", "qiy", "qpy", "qgy", "qwx", "iy", "hy", "xy",
+        "SPACER2", "lambdax", "lambday",
+        "SPACER3", "SPACER4", "Arbeitsmarkt_M", "Arbeitsmarkt_F")
+    # , colClasses = c(qpx = "numeric", qgx = "numeric", qpy = "numeric", qgy = "numeric")
     );
 
+
     male = pensionTable(
         name = name08p(name, "Männer"),
         baseYear = 1982,
@@ -173,42 +179,32 @@ AVOe2008P.generate = function(file, name="P", collar = "Angestellte") {
     list(male = male, female = female)
 }
 
-AVOe2008P.tmp = AVOe2008P.generate("Austria_Pensions_AVOe2008P_Angestellte.csv", "P", collar = "Angestellte")
-AVOe2008P.male = AVOe2008P.tmp$male
-AVOe2008P.female = AVOe2008P.tmp$female
-
-AVOe2008P.tmp = AVOe2008P.generate("Austria_Pensions_AVOe2008P_ArbeiterAngestellte.csv", "P Arb./Ang.", collar = "Mischbestand")
-AVOe2008P.male.ArbAng = AVOe2008P.tmp$male
-AVOe2008P.female.ArbAng = AVOe2008P.tmp$female
-
-AVOe2008P.tmp = AVOe2008P.generate("Austria_Pensions_AVOe2008P_Angestellte.csv", "PK", collar = "Angestellte")
-AVOe2008P.male.PK = AVOe2008P.tmp$male
-AVOe2008P.female.PK = AVOe2008P.tmp$female
-
-AVOe2008P.tmp = AVOe2008P.generate("Austria_Pensions_AVOe2008P_ArbeiterAngestellte.csv", "PK Arb./Ang.", collar = "Mischbestand")
-AVOe2008P.male.ArbAng.PK = AVOe2008P.tmp$male
-AVOe2008P.female.ArbAng.PK = AVOe2008P.tmp$female
-
-
 ############################################################################## #
 # Die Tafel als Array ----
 ############################################################################## #
 
 AVOe2008P = array(
     data = c(mortalityTable.NA),
-    dim = c(2, 2, 1, 2),
-    dimnames = list(Geschlecht = c("m", "w"), Bestand = c("Angestellte", "Mischbestand"), Invalidisierung = c("IP"), Typ = c("P", "PK"))
+    dim = c(2, 2),
+    dimnames = list(Geschlecht = c("m", "w"), Bestand = c("Angestellte", "Mischbestand"))
+)
+AVOe2008PK = array(
+    data = c(mortalityTable.NA),
+    dim = c(2, 2),
+    dimnames = list(Geschlecht = c("m", "w"), Bestand = c("Angestellte", "Mischbestand"))
 )
 
-AVOe2008P[["m", "Angestellte", "IP", "P"]] = AVOe2008P.male
-AVOe2008P[["w", "Angestellte", "IP", "P"]] = AVOe2008P.female
-AVOe2008P[["m", "Mischbestand", "IP", "P"]] = AVOe2008P.male.ArbAng
-AVOe2008P[["w", "Mischbestand", "IP", "P"]] = AVOe2008P.female.ArbAng
+AVOe2008P[, "Angestellte"] = AVOe2008P.generate("Angestellte", "P", collar = "Angestellte")
+AVOe2008P[, "Mischbestand"] = AVOe2008P.generate("Arbeiter+Angestellte", "P Arb./Ang.", collar = "Mischbestand")
+AVOe2008PK[, "Angestellte"] = AVOe2008P.generate("Angestellte PK", "P", collar = "Angestellte")
+AVOe2008PK[, "Mischbestand"] = AVOe2008P.generate("Arbeiter+Angestellte PK", "P Arb./Ang.", collar = "Mischbestand")
 
-AVOe2008P[["m", "Angestellte", "IP", "PK"]] = AVOe2008P.male.PK
-AVOe2008P[["w", "Angestellte", "IP", "PK"]] = AVOe2008P.female.PK
-AVOe2008P[["m", "Mischbestand", "IP", "PK"]] = AVOe2008P.male.ArbAng.PK
-AVOe2008P[["w", "Mischbestand", "IP", "PK"]] = AVOe2008P.female.ArbAng.PK
+AVOe2008P.male = AVOe2008P[["m", "Angestellte"]]
+AVOe2008P.female = AVOe2008P[["w", "Angestellte"]]
+AVOe2008P.male.Misch = AVOe2008P[["m", "Mischbestand"]]
+AVOe2008P.female.Misch = AVOe2008P[["w", "Mischbestand"]]
 
 
 rm(AVOe2008P.generate, AVOe2008P.tmp)
+
+}