diff --git a/R/mortalityTable.observed.R b/R/mortalityTable.observed.R index 491c17903e0c6abd0e95f71b90ff09a222fc1c54..2603acb436e957cd5d018d442c361d5cb4665cb3 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 0000000000000000000000000000000000000000..19b5309ee9a4de4c1a7c48a81c7b6d4894fb7fe0 --- /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 b5a8552405e3c6137b7abd1304225d8cd879fd67..cc4991151137773f6acc561518e61099573d6bba 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