Skip to content
Snippets Groups Projects
Commit 04b579cd authored by Reinhold Kainhofer's avatar Reinhold Kainhofer
Browse files

V2.0.2: Gracefully handle missing suggested packages

Conditionally call functions from suggested / enhanced packages.
In the vignette, print a warning and disable all evaluation if a suggested package is missing that is needed for the vignette.
parent d28185eb
Branches
Tags
No related merge requests found
_R_CHECK_DEPENDS_ONLY_=true
Package: MortalityTables Package: MortalityTables
Type: Package Type: Package
Version: 2.0.1 Version: 2.0.2
Date: 2020-09-07 Date: 2020-12-12
Title: A Framework for Various Types of Mortality / Life Tables Title: A Framework for Various Types of Mortality / Life Tables
Authors@R: c(person("Reinhold", "Kainhofer", role=c("aut", "cre"), email="reinhold@kainhofer.com")) Authors@R: c(person("Reinhold", "Kainhofer", role=c("aut", "cre"), email="reinhold@kainhofer.com"))
Author: Reinhold Kainhofer [aut, cre] Author: Reinhold Kainhofer [aut, cre]
...@@ -11,15 +11,16 @@ BugReports: https://gitlab.open-tools.net/R/r-mortality-tables/-/issues ...@@ -11,15 +11,16 @@ BugReports: https://gitlab.open-tools.net/R/r-mortality-tables/-/issues
Encoding: UTF-8 Encoding: UTF-8
Depends: Depends:
ggplot2, ggplot2,
R (>= 2.10) R (>= 3.5)
Imports: Imports:
methods, methods,
scales, scales,
utils, utils,
pracma pracma
Suggests: Enhances:
lifecontingencies,
MortalityLaws, MortalityLaws,
lifecontingencies
Suggests:
knitr, knitr,
tidyverse, tidyverse,
rmarkdown, rmarkdown,
......
...@@ -7,9 +7,11 @@ NULL ...@@ -7,9 +7,11 @@ NULL
#' @param ... Currently unused #' @param ... Currently unused
#' #'
#' @examples #' @examples
#' mortalityTables.load("Austria_*") #' mortalityTables.load("Austria_Annuities")
#' ages(AVOe2005R.male) #' ages(AVOe2005R.male)
#' ages(AVOe1996R.male) #' ages(AVOe1996R.male)
#'
#' mortalityTables.load("Austria_Census")
#' ages(mort.AT.census.2011.male) #' ages(mort.AT.census.2011.male)
#' #'
#' @exportMethod ages #' @exportMethod ages
......
...@@ -8,12 +8,13 @@ NULL ...@@ -8,12 +8,13 @@ NULL
#' of the life table #' of the life table
#' #'
#' @examples #' @examples
#' if (requireNamespace("lifecontingencies", quietly = TRUE)) {
#' library("lifecontingencies") #' library("lifecontingencies")
#' mortalityTables.load("Austria_Annuities") #' mortalityTables.load("Austria_Annuities")
#' lifeTable(AVOe2005R.male, YOB = 2017) #' lifeTable(AVOe2005R.male, YOB = 2017)
#' axn(lifeTable(AVOe2005R.male, YOB = 1975), x = 65, i = 0.03) #' axn(lifeTable(AVOe2005R.male, YOB = 1975), x = 65, i = 0.03)
#' axn(lifeTable(AVOe2005R.male, YOB = 2017), x = 65, i = 0.03) #' axn(lifeTable(AVOe2005R.male, YOB = 2017), x = 65, i = 0.03)
#' #' }
#' @exportMethod lifeTable #' @exportMethod lifeTable
setGeneric("lifeTable", function(object, ...) standardGeneric("lifeTable")); setGeneric("lifeTable", function(object, ...) standardGeneric("lifeTable"));
...@@ -25,5 +26,29 @@ setMethod("lifeTable","mortalityTable", ...@@ -25,5 +26,29 @@ setMethod("lifeTable","mortalityTable",
if (qx[[length(qx)]] != 1) { if (qx[[length(qx)]] != 1) {
qx = c(qx, 1, 1); qx = c(qx, 1, 1);
} }
lifecontingencies::probs2lifetable(qx, type = "qx") if (requireNamespace("lifecontingencies", quietly = TRUE)) {
lifecontingencies::probs2lifetable(qx, type = "qx")
} else {
warning("The MortalityTables::lifeTable function requires the lifecontingencies package to be installed. Please install it, if you intend to use the lifeTable function.")
}
})
#' @describeIn lifeTable Return the lifetable object (package lifecontingencies) from the mortalityTable objects stored in the array
setMethod("lifeTable", "array",
function(object, ...) {
array(
lapply(object, lifeTable, ...),
dim = dim(object), dimnames = dimnames(object))
}) })
#' @describeIn lifeTable Return the lifetable object (package lifecontingencies) from the mortalityTable objects stored in the list
setMethod("lifeTable", "list",
function(object, ...) {
lapply(object, lifeTable, ...)
})
#' @describeIn lifeTable Empty dummy function to handle unassigned variables
setMethod("lifeTable", "NULL",
function(object, ...) {
NULL
})
...@@ -436,7 +436,11 @@ mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP", ...@@ -436,7 +436,11 @@ mT.fitExtrapolationLaw = function(table, method = "LF2", law = "HP",
fit = 75:99, extrapolate = 80:120, fit = 75:99, extrapolate = 80:120,
fadeIn = 80:90, fadeOut = NULL, raw = NULL) { fadeIn = 80:90, fadeOut = NULL, raw = NULL) {
if (!is(table, "mortalityTable")) if (!is(table, "mortalityTable"))
stop("First argument must be a mortalityTable.") stop("mT.fitExtrapolationLaw: First argument must be a mortalityTable.")
if (!requireNamespace("MortalityLaws", quietly = TRUE)) {
warning("mT.fitExtrapolationLaw: The package `MortalityLaws` is required for this function. Please install it to be able to use mT.fitExtrapolationLaw. Unmodified table will be returned.")
return(table)
}
ages = ages(table) ages = ages(table)
# if (!is.null(table@exposures) && !is.na(table@exposures)) { # if (!is.null(table@exposures) && !is.na(table@exposures)) {
# Ex = table@exposures # Ex = table@exposures
......
...@@ -84,3 +84,15 @@ mortalityTables.load("Austria_*") ...@@ -84,3 +84,15 @@ mortalityTables.load("Austria_*")
## Further information ## Further information
For further information on how to use the package, see the "Using the MortalityTables Package" vignette. For further information on how to use the package, see the "Using the MortalityTables Package" vignette.
## Changelog
* Version 1.0 (30.3.2018): Initial Submission to CRAN
* Version 2.0 (27.8.2020):
* Add various convenience functions to derive tables from data, implement dimensional information
* Version 2.0.1 (4.9.2020):
* Fix performance issues with mortalityTables.list and mortalityTables.load
* Version 2.0.2 (12.12.2020):
* Add/fix some sample tables
* gracefully handle missing suggested packages
* First version of vignette about international tables
...@@ -39,9 +39,11 @@ Return the defined ages of the life table ...@@ -39,9 +39,11 @@ Return the defined ages of the life table
}} }}
\examples{ \examples{
mortalityTables.load("Austria_*") mortalityTables.load("Austria_Annuities")
ages(AVOe2005R.male) ages(AVOe2005R.male)
ages(AVOe1996R.male) ages(AVOe1996R.male)
mortalityTables.load("Austria_Census")
ages(mort.AT.census.2011.male) ages(mort.AT.census.2011.male)
} }
...@@ -3,11 +3,20 @@ ...@@ -3,11 +3,20 @@
\name{lifeTable} \name{lifeTable}
\alias{lifeTable} \alias{lifeTable}
\alias{lifeTable,mortalityTable-method} \alias{lifeTable,mortalityTable-method}
\alias{lifeTable,array-method}
\alias{lifeTable,list-method}
\alias{lifeTable,NULL-method}
\title{Return the lifetable object (package lifecontingencies) for the cohort life table} \title{Return the lifetable object (package lifecontingencies) for the cohort life table}
\usage{ \usage{
lifeTable(object, ...) lifeTable(object, ...)
\S4method{lifeTable}{mortalityTable}(object, ...) \S4method{lifeTable}{mortalityTable}(object, ...)
\S4method{lifeTable}{array}(object, ...)
\S4method{lifeTable}{list}(object, ...)
\S4method{lifeTable}{`NULL`}(object, ...)
} }
\arguments{ \arguments{
\item{object}{The life table object (class inherited from mortalityTable)} \item{object}{The life table object (class inherited from mortalityTable)}
...@@ -22,13 +31,20 @@ Return the lifetable object (package lifecontingencies) for the cohort life tabl ...@@ -22,13 +31,20 @@ Return the lifetable object (package lifecontingencies) for the cohort life tabl
\itemize{ \itemize{
\item \code{mortalityTable}: Return the lifetable object (package lifecontingencies) \item \code{mortalityTable}: Return the lifetable object (package lifecontingencies)
for the cohort life table for the cohort life table
\item \code{array}: Return the lifetable object (package lifecontingencies) from the mortalityTable objects stored in the array
\item \code{list}: Return the lifetable object (package lifecontingencies) from the mortalityTable objects stored in the list
\item \code{NULL}: Empty dummy function to handle unassigned variables
}} }}
\examples{ \examples{
if (requireNamespace("lifecontingencies", quietly = TRUE)) {
library("lifecontingencies") library("lifecontingencies")
mortalityTables.load("Austria_Annuities") mortalityTables.load("Austria_Annuities")
lifeTable(AVOe2005R.male, YOB = 2017) lifeTable(AVOe2005R.male, YOB = 2017)
axn(lifeTable(AVOe2005R.male, YOB = 1975), x = 65, i = 0.03) axn(lifeTable(AVOe2005R.male, YOB = 1975), x = 65, i = 0.03)
axn(lifeTable(AVOe2005R.male, YOB = 2017), x = 65, i = 0.03) axn(lifeTable(AVOe2005R.male, YOB = 2017), x = 65, i = 0.03)
}
} }
...@@ -21,8 +21,19 @@ knitr::opts_chunk$set( ...@@ -21,8 +21,19 @@ knitr::opts_chunk$set(
) )
``` ```
```{r PackageCheck, echo = FALSE}
required <- c("tidyverse")
if (!all(sapply(required,
function(pkg) requireNamespace(pkg, quietly = TRUE)))) {
message(paste("This vignette needs the followig packages:\n\t",
paste(required, collapse = " "),
"\nSince not all are installed, code will not be executed: "))
knitr::opts_chunk$set(eval = FALSE)
}
```
```{r setup} ```{r setup}
library(magrittr) library(tidyverse, quietly = TRUE)
library(MortalityTables) library(MortalityTables)
mortalityTables.load("Austria_Census") mortalityTables.load("Austria_Census")
``` ```
...@@ -49,6 +60,7 @@ Annuity tables in Austria are traditionally published by the [Actuarial Associat ...@@ -49,6 +60,7 @@ Annuity tables in Austria are traditionally published by the [Actuarial Associat
### ÖVM 59/61 - RR 67 ### ÖVM 59/61 - RR 67
[TODO: Get actual table data and publication] [TODO: Get actual table data and publication]
* Source: H. Nabl: ÖVM 59/61 - RR67 - 3%, Die Versicherungsrundschau, 22. Jahrgang, Heft 12, Dez. 1967, p.373--380. * Source: H. Nabl: ÖVM 59/61 - RR67 - 3%, Die Versicherungsrundschau, 22. Jahrgang, Heft 12, Dez. 1967, p.373--380.
```{r} ```{r}
...@@ -402,7 +414,6 @@ PKBestandstafel.2010.16 ...@@ -402,7 +414,6 @@ PKBestandstafel.2010.16
```{r PKBestand.vergleich} ```{r PKBestand.vergleich}
plotMortalityTables(PKBestandstafel.2010.16[,,"qx", "raw"], legend.position = "right", title = "Austrian pension fund mortalities 2010-16", aes = aes(color = type)) + plotMortalityTables(PKBestandstafel.2010.16[,,"qx", "raw"], legend.position = "right", title = "Austrian pension fund mortalities 2010-16", aes = aes(color = type)) +
facet_grid(sex ~ .) + labs(color = "Collective") facet_grid(sex ~ .) + labs(color = "Collective")
PKBestandstafel.2010.16[1,1,1,1]
``` ```
...@@ -664,6 +675,7 @@ Fischer Verlag, Weissenburg/Bayern, 1959 ...@@ -664,6 +675,7 @@ Fischer Verlag, Weissenburg/Bayern, 1959
[TODO] [TODO]
https://aktuar.de/unsere-themen/lebensversicherung/Seiten/default.aspx https://aktuar.de/unsere-themen/lebensversicherung/Seiten/default.aspx
* Source: Klaus Heubeck, Richard Herrmann und Gabriele D’Souza. „Die Richttafeln 2005 G – Modell, Herleitung, Formeln“. In: Blätter der DGVFM 27.3 (Apr. 2006), S. 473–517. * Source: Klaus Heubeck, Richard Herrmann und Gabriele D’Souza. „Die Richttafeln 2005 G – Modell, Herleitung, Formeln“. In: Blätter der DGVFM 27.3 (Apr. 2006), S. 473–517.
...@@ -701,6 +713,7 @@ Source: [https://content.naic.org/sites/default/files/pbr_data_valuation_manual_ ...@@ -701,6 +713,7 @@ Source: [https://content.naic.org/sites/default/files/pbr_data_valuation_manual_
Source: Society of Actuaries. RP-2014 Mortality Tables Report. Techn. Ber. Okt. 2014. URL: https://www.soa. Source: Society of Actuaries. RP-2014 Mortality Tables Report. Techn. Ber. Okt. 2014. URL: https://www.soa.
org/experience-studies/2014/research-2014-rp/. org/experience-studies/2014/research-2014-rp/.
Source: Society of Actuaries. Mortality Improvement Scale MP-2014 Report. Techn. Ber. Okt. 2014. URL: https: Source: Society of Actuaries. Mortality Improvement Scale MP-2014 Report. Techn. Ber. Okt. 2014. URL: https:
//www.soa.org/experience-studies/2014/research-2014-mp/. //www.soa.org/experience-studies/2014/research-2014-mp/.
......
## ----echo = FALSE-------------------------------------------------------------
knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
options(tidyverse.quiet = TRUE)
## ----message=FALSE------------------------------------------------------------
library("MortalityTables")
## -----------------------------------------------------------------------------
# list all available data sets
mortalityTables.list()
# list all datasets for Austria
mortalityTables.list("Austria_*")
# Load the German annuity table DAV 2004-R
mortalityTables.load("Germany_Annuities_DAV2004R")
# Load all Austrian annuity data sets
mortalityTables.load("Austria_Annuities*")
mortalityTables.load("Austria_Census")
## -----------------------------------------------------------------------------
# Log-linear plot comparing some Austrian census tables
plot(mort.AT.census.1951.male, mort.AT.census.1991.male,
mort.AT.census.2001.male, mort.AT.census.2011.male,
legend.position = c(1,0))
# Relative death probabilities in percentage of the latest census
plot(mort.AT.census.1951.male, mort.AT.census.1991.male,
mort.AT.census.2001.male,
reference = mort.AT.census.2011.male, legend.position = c(1,0.75), ylim = c(0,4))
## -----------------------------------------------------------------------------
# Comparison of two Austrian annuity tables for birth year 1977
plot(AVOe1996R.male, AVOe2005R.male, YOB = 1977, title = "Comparison for YOB=1977")
# Comparison of two Austrian annuity tables for observation year 2020
plot(AVOe1996R.male, AVOe2005R.male, Period = 2020, title = "Comparison for observation year 2020")
## ----message=FALSE------------------------------------------------------------
mortalityTables.load("Austria_Annuities")
# Get the cohort death probabilities for Austrian Annuitants born in 1977:
qx.coh1977 = deathProbabilities(AVOe2005R.male, YOB = 1977)
# Get the period death probabilities for Austrian Annuitants observed in the year 2020:
qx.per2020 = periodDeathProbabilities(AVOe2005R.male, Period = 2020)
## -----------------------------------------------------------------------------
# Get the cohort death probabilities for Austrian Annuitants born in 1977 as a mortalityTable.period object:
table.coh1977 = getCohortTable(AVOe2005R.male, YOB = 1977)
# Get the period death probabilities for Austrian Annuitants observed in the year 2020:
table.per2020 = getPeriodTable(AVOe2005R.male, Period = 2020)
# Compare those two in a plot:
plot(table.coh1977, table.per2020, title = "Comparison of cohort 1977 with Period 2020", legend.position = c(1,0))
## ----DimensionalInfoPlot------------------------------------------------------
plotMortalityTables(
mort.AT.census[c("m", "w"), c("1951", "1991", "2001", "2011")]) +
aes(color = as.factor(year), linetype = sex) + labs(color = "Period", linetype = "Sex")
## ----DimensionalInformationStorage--------------------------------------------
mort.AT.census.2011.male@data$dim
## -----------------------------------------------------------------------------
lt = mortalityTable.period(name = "Sample period lifetable", ages = 1:99, deathProbs = exp(-(99:1)/10))
plot(lt, title = "Simple log-linear period mortality table")
deathProbabilities(lt)
## -----------------------------------------------------------------------------
atPlus2 = mortalityTable.trendProjection(
name = "Austrian Census Males 2011, 2% yearly trend",
baseYear = 2011,
deathProbs = deathProbabilities(mort.AT.census.2011.male),
ages = ages(mort.AT.census.2011.male),
trend = rep(0.02, length(ages(mort.AT.census.2011.male)))
)
## -----------------------------------------------------------------------------
atPlus2.damp = mortalityTable.trendProjection(
name = "Austrian M '11, 2% yearly, damping until 2111",
baseYear = 2011,
deathProbs = deathProbabilities(mort.AT.census.2011.male),
ages = ages(mort.AT.census.2011.male),
trend = rep(0.02, length(ages(mort.AT.census.2011.male))),
# damping function: 2011: full effect, linear reduction until yearly trend=0 in 2111:
# 2011: 100%, 2012: 99%, 2013: 98% => For 2013 we have a cumulative trend
# of 297% instead of 300% for three full yearly trends!
dampingFunction = function(n) { n - n * (n + 1) / 2 / 100 }
)
plot(mort.AT.census.2011.male, atPlus2, atPlus2.damp, YOB = 2011, legend.position = c(0.8,0.75))
## -----------------------------------------------------------------------------
atPlus2.damp2 = mortalityTable.trendProjection(
name = "Austrian M '11, 2% yearly, 1% long-term",
baseYear = 2011,
deathProbs = deathProbabilities(mort.AT.census.2011.male),
ages = ages(mort.AT.census.2011.male),
trend = rep(0.02, length(ages(mort.AT.census.2011.male))),
trend2 = rep(0.01, length(ages(mort.AT.census.2011.male))),
# damping function interpolates between the two trends:
# until 2021 trend 1, from 2031 trend 2, linearly beteen
dampingFunction = function(year) {
if (year <= 2021) 1
else if (year > 2031) 14.5/(year - 2011)
else 1 - (year - 2021)*(year - 2021 + 1) / 20 / (year - 2011)
}
)
plot(mort.AT.census.2011.male, atPlus2, atPlus2.damp, atPlus2.damp2, YOB = 2011, legend.position = c(0.02, 0.98), legend.justification = c(0, 1))
## -----------------------------------------------------------------------------
baseTableShift = getCohortTable(atPlus2, YOB = 2011);
baseTableShift@name = "Base table of the shift (YOB 2011)"
atShifted = mortalityTable.ageShift(
name = "Approximation with age shift",
baseYear = 2011,
deathProbs = deathProbabilities(baseTableShift),
ages = ages(baseTableShift),
ageShifts = data.frame(
shifts = c(
rep( 0, 3),
rep(-1, 3),
rep(-2, 3),
rep(-3, 3),
rep(-4, 3),
rep(-5, 3),
rep(-6, 3)
),
row.names = 2011:2031
)
)
ageShift(atShifted, YOB = 2021)
plot(baseTableShift, atPlus2, atShifted, YOB = 2021, legend.position = c(0.8,0.75))
## -----------------------------------------------------------------------------
b = AVOe2005R.female
b@name = "Modified Copy"
# only b is modified, not the original table
b@modification = function(qx) pmax(qx, 0.01)
plot(AVOe2005R.female, b, YOB = 2000)
## -----------------------------------------------------------------------------
AVOe2005R.female.sec = setLoading(AVOe2005R.female, loading = 0.1);
# Make sure the modified table has a new name, otherwise plots might break
AVOe2005R.female.sec@name = "Table with 10% loading"
plot(AVOe2005R.female, AVOe2005R.female.sec, title = "Original and modified table")
## -----------------------------------------------------------------------------
AVOe2005R.female.mod = setModification(AVOe2005R.female, modification = function(qx) pmax(0.03, qx));
# Make sure the modified table has a new name, otherwise plots might break
AVOe2005R.female.mod@name = "Modified table (lower bound of 3%)"
plot(AVOe2005R.female, AVOe2005R.female.mod, title = "Original and modified table")
## ----AustrianPopulation.RawData-----------------------------------------------
library(tidyverse)
data("PopulationData.AT2017", package = "MortalityTables")
PopulationData.AT2017.raw = PopulationData.AT2017 %>%
select(age, exposure.total, deaths.total) %>%
mutate(qraw = deaths.total / (exposure.total + deaths.total/2))
## ----AustrianPopulationTableRaw-----------------------------------------------
PopulationTable.AT2017 = mortalityTable.period(
name = "Austrian Population Mortality 2017 (raw)",
baseYear = 2017,
deathProbs = PopulationData.AT2017.raw$qraw,
ages = PopulationData.AT2017.raw$age,
exposures = PopulationData.AT2017.raw$exposure.total,
data = list(
deaths = PopulationData.AT2017.raw$deaths.total,
dim = list(sex = "u", collar = "Population", type = "raw", year = "2017")
)
)
plotMortalityTables(PopulationTable.AT2017, title = "Austrian population mortality (raw), 2017")
## ----AustrianPopulationTableSmooth--------------------------------------------
PopulationTable.AT2017.smooth = PopulationTable.AT2017 %>%
whittaker.mortalityTable(lambda = 1/10, d = 2, name.postfix = ", Whittaker") %>%
mT.setDimInfo(type = "smoothed")
plotMortalityTables(PopulationTable.AT2017, PopulationTable.AT2017.smooth, title = "Austrian population mortality (raw and smoothed), 2017") +
aes(colour = type)
## ----AustrianPopulationTableCut100--------------------------------------------
PopulationData.AT2017.raw %>% filter(age > 90)
PopulationTable.AT2017.cut = PopulationTable.AT2017.smooth %>%
mT.fillAges(0:99) %>%
mT.setName("Austrian Population Mortality 2017, Whittaker-smoothed and cut at age 99")
## ----AustrianPopulationTableExtrapolated--------------------------------------
PopulationTable.AT2017.ex = PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "HP2", fit = 75:99, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "smoothed and extrapolated")
plotMortalityTables(PopulationTable.AT2017, PopulationTable.AT2017.smooth, PopulationTable.AT2017.ex, title = "Austrian population mortality (raw and smoothed), 2017") +
aes(colour = type)
## ----AustrianPopulationTableFitComparison-------------------------------------
plotMortalityTables(
PopulationTable.AT2017,
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "HP2", fit = 75:99, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "Extrapolation: HP2, Fit 75--99"),
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "HP2", fit = 75:85, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "Extrapolation: HP, Fit 75--85"),
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "HP2", fit = 90:110, extrapolate = 80:120, fadeIn = 90:100) %>%
mT.setDimInfo(type = "Extrapolation: HP2, Fit 90--110"),
title = "Examples of different fitting ranges for extrapolation") +
aes(colour = type)
## ----AustrianPopulationTableFitFunctionComparison-----------------------------
plotMortalityTables(
PopulationTable.AT2017,
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "HP2", fit = 75:99, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "HP2"),
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "thiele", fit = 75:99, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "thiele"),
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "ggompertz", fit = 75:99, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "ggompertz"),
PopulationTable.AT2017.smooth %>%
mT.fitExtrapolationLaw(law = "carriere1", fit = 75:99, extrapolate = 80:120, fadeIn = 80:95) %>%
mT.setDimInfo(type = "carriere1"),
title = "Examples of different fitting functions for extrapolation (fit 75--99)",
ages = 75:120, legend.position = "bottom", legend.key.width = unit(15, "mm")) +
aes(colour = type) + labs(colour = "Mortality Law")
## ----AustrianPopulationTableTrendForecast-------------------------------------
mortalityTables.load("Austria_PopulationForecast")
plotMortalityTrend(mort.AT.forecast, title = "Forecast trend (medium scenario) by Statistik Austria")
## ----AustrianPopulationTableTrend---------------------------------------------
PopulationTable.AT2017.trend = PopulationTable.AT2017.ex %>%
mT.addTrend(mort.AT.forecast$m@trend, trendages = ages(mort.AT.forecast$m)) %>%
mT.setDimInfo(type = "smoothed, extrapolated, trend")
PopulationTable.AT2017.trend.ex = PopulationTable.AT2017.trend %>%
mT.extrapolateTrendExp(95) %>%
mT.setDimInfo(type = "smoothed, extrapolated, trend extrapolated")
plotMortalityTrend(PopulationTable.AT2017.trend, PopulationTable.AT2017.trend.ex,
title = "Extrapolating the trend via Exponential function") +
aes(color = type)
plotMortalityTables(PopulationTable.AT2017, PopulationTable.AT2017.smooth, PopulationTable.AT2017.ex, PopulationTable.AT2017.trend.ex, YOB = 1980, title = "Austrian population mortality (Period 2017 vs. Generation 1980)", legend.position = c(0.01, 0.99), legend.justification = c(0,1)) +
aes(colour = type)
## ----AustrianPopulationTableFinal---------------------------------------------
# Lots of non-essential or support information is stored inside the table's data field:
PopulationTable.AT2017.trend.ex@data$whittaker
# Clean up the table (remove all non-essential data, but do not modify results)
PopulationTable.AT2017.Cohort.FINAL = PopulationTable.AT2017.trend.ex %>%
mT.cleanup() %>%
mT.round(digits = 6) %>%
mT.setName("Austrian Population Mortality, Period 2017 with trend projection")
## ----AustrianPopulationTableScaled--------------------------------------------
TableForProduct = PopulationTable.AT2017.Cohort.FINAL %>%
mT.scaleProbs(factor = 1.25, name.postfix = "10% security added")
plotMortalityTables(TableForProduct, PopulationTable.AT2017.Cohort.FINAL,
title = "Adding a security loading of 25%", Period = 2017, legend.position = "bottom")
...@@ -15,6 +15,17 @@ vignette: > ...@@ -15,6 +15,17 @@ vignette: >
%\VignetteEncoding{UTF-8} %\VignetteEncoding{UTF-8}
--- ---
```{r PackageCheck}
required <- c("tidyverse")
if (!all(sapply(required,
function(pkg) requireNamespace(pkg, quietly = TRUE)))) {
message(paste("This vignette needs the followig packages:\n\t",
paste(required, collapse = " "),
"\nSince not all are installed, code will not be executed: "))
knitr::opts_chunk$set(eval = FALSE)
}
```
```{r echo = FALSE} ```{r echo = FALSE}
knitr::opts_chunk$set(collapse = TRUE, comment = "#>") knitr::opts_chunk$set(collapse = TRUE, comment = "#>")
options(tidyverse.quiet = TRUE) options(tidyverse.quiet = TRUE)
......
Source diff could not be displayed: it is too large. Options to address this: view the blob.
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment