From 7d7aa3bbfd23643ee1c9f3edef610b513720202b Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Wed, 21 Sep 2016 14:32:26 +0000
Subject: [PATCH] Add function mortalityComparisonTable

---
 DESCRIPTION                     |  1 +
 NAMESPACE                       |  1 +
 R/mortalityComparisonTable.R    | 52 +++++++++++++++++++++++++++++++++
 man/mortalityComparisonTable.Rd | 31 ++++++++++++++++++++
 4 files changed, 85 insertions(+)
 create mode 100644 R/mortalityComparisonTable.R
 create mode 100644 man/mortalityComparisonTable.Rd

diff --git a/DESCRIPTION b/DESCRIPTION
index a234012..6bb50e2 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 cbe485d..d0d1c93 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 0000000..92731a3
--- /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 0000000..2027275
--- /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)
+
+
+}
+
-- 
GitLab