ICSLT 2013 / 2018 implemented

R/mortalityTable.observed.R

@@ -82,7 +82,7 @@ setMethod("periodDeathProbabilities", "mortalityTable.observed",
               # find the given year that is closest to the desired year:
               #
               fillAges(
-                  object@modification(object@deathProbs[,col] * (1 + object@loading)),
+                  object@modification(object@deathProbs[, col, drop = TRUE] * (1 + object@loading)),
                   givenAges = ages(object),
                   neededAges = ages)
           })
@@ -104,7 +104,7 @@ setMethod("deathProbabilities","mortalityTable.observed",
                           " of observed mortalityTable are available, using closest observations.\nAvailable periods: ", findIntRuns(object@years))
               }
 
-              qx = object@deathProbs[cbind(agerows, yearcols)] * (1 + object@loading);
+              qx = object@deathProbs[cbind(agerows, yearcols), drop = TRUE] * (1 + object@loading);
               fillAges(object@modification(qx), givenAges = ages(object), neededAges = ages)
           })
 

inst/extdata/MortalityTables_ICSLT.R

+#' @import MortalityTables
+NULL
+
+stopifnot(require(methods), require(utils), require(MortalityTables), require(dplyr)) # MortalityTable classes; new; Excel reader
+
+############################################################################### #
+# ICSLT - International Civil Servants Life Table                            ----
+############################################################################### #
+
+
+readICSLT = function(filename, name = "ICSLT 2018", year = 2018, coloffset = 0) {
+  ICSLT = array(
+    data = c(mortalityTable.NA),
+    dim = c(2),
+    dimnames = list(Sex = c("m", "w"))
+  )
+  # browser()
+  head = read_excel(filename, skip = 3, n_max = 2, col_names = FALSE, .name_repair = "minimal")
+  qx = read_excel(filename, skip = 5, col_names = FALSE, .name_repair = "minimal")
+  # browser()
+  ICSLT$m = mortalityTable.observed(
+    name = "ICSLT 2018 Male",
+    deathProbs = as.data.frame(unname(qx[,which(head[2,] == "qx_Male") + coloffset])),
+    years = as.numeric(head[1,which(head[2,] == "qx_Male")]),
+    ages = qx[,1, drop = TRUE],
+    data = list(
+      dim = list(sex = "m", collar = "ICSLT", type = name, data = "official", year = year)
+    )
+  )
+  ICSLT$w = mortalityTable.observed(
+    name = "ICSLT 2018 Female",
+    deathProbs = as.data.frame(unname(qx[,which(head[2,] == "qx_Female") + coloffset])),
+    years = as.numeric(head[1,which(head[2,] == "qx_Female")]),
+    ages = qx[,1, drop = TRUE],
+    data = list(
+      dim = list(sex = "f", collar = "ICSLT", type = name, data = "official", year = year)
+    )
+  )
+  ICSLT
+}
+
+
+if (!is.null(getOption("MortalityTables.ICSLT2018"))) {
+  ICSLT2018 = readICSLT(getOption("MortalityTables.ICSLT2018"), name = "ICSLT 2018", year = 2018, coloffset = 0)
+} else {
+  message("Path to the ICSLT©2018.xlsx data file (option 'MortalityTables.ICSLT2018' not set, ICSLT2018 will not be available!")
+}
+if (!is.null(getOption("MortalityTables.ICSLT2013"))) {
+  ICSLT2013 = readICSLT(getOption("MortalityTables.ICSLT2013"), name = "ICSLT 2013", year = 2013, coloffset = 1)
+} else {
+  message("Path to the ICSLT©2013.xlsx data file (option 'MortalityTables.ICSLT2013' not set, ICSLT2013 will not be available!")
+}
+if (!is.null(getOption("MortalityTables.ICSLT2008"))) {
+  ICSLT2008 = readICSLT(getOption("MortalityTables.ICSLT2008"), name = "ICSLT 2008", year = 2008)
+} else {
+  message("Path to the ICSLT©2008.xlsx data file (option 'MortalityTables.ICSLT2008' not set, ICSLT2008 will not be available!")
+}
+
+# options(MortalityTables.ICSLT2013 = "/home/reinhold/R/Tables-Private/ICSLT/ICSLT©2013.xlsx")
+# options(MortalityTables.ICSLT2018 = "/home/reinhold/R/Tables-Private/ICSLT/ICSLT©2018.xlsx")
+# plotMortalityTables(ICSLT2018, ICSLT2013, aes = aes(color = type, linetype = sex))
+
+rm(readICSLT)

vignettes/international-mortality-tables-overview.Rmd

@@ -84,10 +84,13 @@ mortalityTables.load("Austria_Census")
 
 Source: https://www.sirp-isrp.org/index.php?option=com_content&view=article&id=1057:public-carrousel-actuaries&catid=247:public-home-carrousel&Itemid=992&lang=en
 
+* ICSLT 2008
 * ICSLT 2013
 * ICSLT 2018
 
-TODO
+## EU Civil Servant Life Table
+
+* EU Life Table 2016