From 523fbb6a1758a6e3358460cb7452a4d8f158e258 Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Sun, 14 Feb 2021 13:26:06 +0100
Subject: [PATCH] ICSLT 2013 / 2018 implemented

---
 R/mortalityTable.observed.R                   |  4 +-
 inst/extdata/MortalityTables_ICSLT.R          | 63 +++++++++++++++++++
 ...nternational-mortality-tables-overview.Rmd |  5 +-
 3 files changed, 69 insertions(+), 3 deletions(-)
 create mode 100644 inst/extdata/MortalityTables_ICSLT.R

diff --git a/R/mortalityTable.observed.R b/R/mortalityTable.observed.R
index 491c179..2603acb 100644
--- a/R/mortalityTable.observed.R
+++ b/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)
           })
 
diff --git a/inst/extdata/MortalityTables_ICSLT.R b/inst/extdata/MortalityTables_ICSLT.R
new file mode 100644
index 0000000..19b5309
--- /dev/null
+++ b/inst/extdata/MortalityTables_ICSLT.R
@@ -0,0 +1,63 @@
+#' @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)
diff --git a/vignettes/international-mortality-tables-overview.Rmd b/vignettes/international-mortality-tables-overview.Rmd
index b5a8552..cc49911 100644
--- a/vignettes/international-mortality-tables-overview.Rmd
+++ b/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 
 
 
 
-- 
GitLab