diff --git a/DESCRIPTION b/DESCRIPTION index a234012da9cce68e804fe438176f949a35902dac..6bb50e288a1796e6ad5dfac3275feb5ca81a37d6 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -42,6 +42,7 @@ Collate: 'getPeriodTable.R' 'lifeTable.R' 'makeQxDataFrame.R' + 'mortalityComparisonTable.R' 'mortalityTables.list.R' 'mortalityTables.load.R' 'periodDeathProbabilities.R' diff --git a/NAMESPACE b/NAMESPACE index cbe485dc843d1eb40d1d196c0ebf3fa0738114b2..d0d1c93ddc9aed28009185e4c7e92a51a3d6b697 100644 --- a/NAMESPACE +++ b/NAMESPACE @@ -2,6 +2,7 @@ S3method(plot,mortalityTable) export(makeQxDataFrame) +export(mortalityComparisonTable) export(mortalityTable) export(mortalityTable.ageShift) export(mortalityTable.improvementFactors) diff --git a/R/mortalityComparisonTable.R b/R/mortalityComparisonTable.R new file mode 100644 index 0000000000000000000000000000000000000000..92731a3ce82981198a01ee796a1bf9c80e052457 --- /dev/null +++ b/R/mortalityComparisonTable.R @@ -0,0 +1,52 @@ + +ageRanges = function(ages, binsize = 5) { + rangestart = floor(ages / binsize) * binsize + sapply(X = rangestart, FUN = function(start) sprintf("%d-%d", start, start + binsize - 1) ) +} + +#' Calculate relative mortalities for age bands and birth years +#' +#' @param table1,table2 The \code{\link{mortalityTable}} objects to compare (mortalities of \code{table1} relative to \code{table2}) +#' @param years Vector of birth years to include in the comparisons. +#' @param ages Vector of ages to include in the comparisons +#' @param binsize How many ages to combine into one age band +#' +#' @examples +#' mortalityTables.load("Austria_Annuities") +#' # Compare mortality of Austrian male and female annuitants born 1930 to 2030 +#' mortalityComparisonTable(AVOe2005R.male, AVOe2005R.female, years = seq(1930, 2030, by = 10), ages = 0:119) +#' +#' # Compare the two Austrian male annuity tables AVÖ 2005-R and AVÖ 1996-R, combine ages 10-19, 20-29, etc. +#' mortalityComparisonTable(AVOe2005R.male, AVOe1996R.male, years = seq(1930, 2030, by = 10), ages = 0:109, binsize=10) +#' +#' +#' @export +mortalityComparisonTable = function(table1, table2, years, ages, binsize = 5, ...) { + q1 = as.data.frame( + sapply(years, FUN = function(y) { deathProbabilities(table1, YOB = y) }), + row.names = ages(table1) + ); + colnames(q1) <- years + # Select only the given ages! + q1 = q1[as.character(ages),] + + q2 = as.data.frame( + sapply(years, FUN = function(y) { deathProbabilities(table2, YOB = y) }), + row.names = ages(table2) + ); + colnames(q2) <- years + # Select only the given ages! + q2 = q2[as.character(ages),] + + + # Calculate the ratios of female:male mortality and average in bin sizes of 5: + ratios = (q1/q2) + ageRanges = ageRanges(as.numeric(rownames(ratios)), binsize=binsize) + averages = aggregate(ratios, by = list(Ages = factor(ageRanges, levels = unique(ageRanges))), FUN = mean) + rownames(averages) = averages$Ages + averages$Ages = NULL + + averages +} + +# mortalityComparisonTable(AVOe2008P.female.aa, AVOe2008P.male.aa, years = seq(1932, 2022, by = 10), ages = 15:119, binsize=10) diff --git a/man/mortalityComparisonTable.Rd b/man/mortalityComparisonTable.Rd new file mode 100644 index 0000000000000000000000000000000000000000..202727506d08afb096b95451c934a7764f773026 --- /dev/null +++ b/man/mortalityComparisonTable.Rd @@ -0,0 +1,31 @@ +% Generated by roxygen2: do not edit by hand +% Please edit documentation in R/mortalityComparisonTable.R +\name{mortalityComparisonTable} +\alias{mortalityComparisonTable} +\title{Calculate relative mortalities for age bands and birth years} +\usage{ +mortalityComparisonTable(table1, table2, years, ages, binsize = 5, ...) +} +\arguments{ +\item{table1, table2}{The \code{\link{mortalityTable}} objects to compare (mortalities of \code{table1} relative to \code{table2})} + +\item{years}{Vector of birth years to include in the comparisons.} + +\item{ages}{Vector of ages to include in the comparisons} + +\item{binsize}{How many ages to combine into one age band} +} +\description{ +Calculate relative mortalities for age bands and birth years +} +\examples{ +mortalityTables.load("Austria_Annuities") +# Compare mortality of Austrian male and female annuitants born 1930 to 2030 +mortalityComparisonTable(AVOe2005R.male, AVOe2005R.female, years = seq(1930, 2030, by = 10), ages = 0:119) + +# Compare the two Austrian male annuity tables AVÖ 2005-R and AVÖ 1996-R, combine ages 10-19, 20-29, etc. +mortalityComparisonTable(AVOe2005R.male, AVOe1996R.male, years = seq(1930, 2030, by = 10), ages = 0:109, binsize=10) + + +} +