New function plotMortalityTrend to plot the yearly mortality improvements of...

New function plotMortalityTrend to plot the yearly mortality improvements of multiple tables (either for a given period or a given generation)

DESCRIPTION

@@ -52,6 +52,7 @@ Collate:
     'plot.mortalityTable.R'
     'plotMortalityTableComparisons.R'
     'plotMortalityTables.R'
+    'plotMortalityTrend.R'
     'setLoading.R'
     'setModification.R'
     'undampenTrend.R'

NAMESPACE

@@ -24,6 +24,7 @@ export(pensionTables.list)
 export(pensionTables.load)
 export(plotMortalityTableComparisons)
 export(plotMortalityTables)
+export(plotMortalityTrend)
 exportClasses(mortalityTable)
 exportClasses(mortalityTable.ageShift)
 exportClasses(mortalityTable.improvementFactors)

R/plotMortalityTrend.R

+#' Plot the trends of multiple mortality tables (life tables) in one chart
+#'
+#' \code{plotMortalityTrend} prints the trends of multiple life tables (objects
+#' of child classes of \code{mortalityTable}) in one plot, with a legend showing
+#' the names of the tables.
+#'
+#' @param data First life table to be plotted. Either a \code{data.frame} generated by \code{makeQxDataFrame} or a \code{mortalityTable} object
+#' @param ... Additional life tables to be plotted (if \code{data} is a \code{mortalityTable} object)
+#' @param xlim X-axis limitatation (as a two-element vector)
+#' @param ylim Y-axis limitatation (as a two-element vector)
+#' @param xlab X-axis label (default: "Alter")
+#' @param ylab Y-axis label (default: "Sterbewahrscheinlichkeit q_x relativ zu ....")
+#' @param title The plot title
+#' @param legend.position The position of the legend (default is \code{c(0.9,0.1)})
+#' @param legend.key.width The keywith of the lines in the  legend (default is \code{unit(25,"mm")})
+#'
+#' @import scales
+#' @export
+plotMortalityTrend = function(data, ..., xlim=NULL, ylim=NULL, xlab=NULL, ylab=NULL, title = "", legend.position=c(0.9,0.9), legend.key.width = unit(25, "mm")) {
+    if (!is.data.frame(data)) {
+        data = makeMortalityTrendDataFrame(data, ...);
+    }
+    if (missing(xlab)) xlab = "Alter";
+    if (missing(ylab)) ylab = expression(paste("Sterblichkeitstrend ", lambda[x]));
+
+  pl = ggplot(data, aes(x = x, y = y, colour = data$group)) +
+    theme_bw() +
+    theme(
+      plot.title = element_text(size = 18, face = "bold"),
+      legend.title = element_text(size = 14, face = "bold.italic"),
+      # legend in bottom right corner of the plot
+      legend.justification = c(1,1), legend.position = legend.position,
+      # No box around legend entries
+      legend.key = element_blank(),
+      legend.key.width = legend.key.width,
+      legend.background = element_rect(colour = "gray50", linetype = "solid")
+    ) +
+    geom_line() +
+    scale_y_continuous(
+      name = ylab,
+#      breaks = scales::trans_breaks('log10', function(x) 10^x),
+#      labels = scales::trans_format('log10', scales::math_format(10^.x))
+      #minor_breaks = log(c(sapply(x, function(x) seq(0, x, x/10))), 10)
+    ) +
+    scale_x_continuous(
+      name = xlab,
+      #breaks = function (limits) scales::trans_breaks('', function(x) 10^x),
+      breaks = function(limits) seq(max(min(limits), 0), max(limits), 5),
+      minor_breaks = function(limits) seq(max(round(min(limits)), 0), round(max(limits)), 1)
+      #labels = scales::trans_format('log10', scales::math_format(10^.x))
+    ) +
+    coord_cartesian(xlim = xlim, ylim = ylim) +
+    annotation_logticks(sides = "lr") +
+    xlab("Alter") + labs(colour = "Sterbetafel");
+  if (title != "") {
+    pl = pl + ggtitle(title);
+  }
+  pl
+}
+
+makeMortalityTrendDataFrame = function(..., YOB = 1972, Period = NULL) {
+    # If reference is given, normalize all probabilities by that table!
+    data = list(...);
+    names(data) = lapply(data, function(t) t@name);
+
+    if (missing(Period) || is.null(Period)) {
+        data = lapply(data, function(t) {
+                cbind(x = ages(t), y = mortalityImprovement(t, YOB = YOB))
+        });
+    } else {
+        data = lapply(data, function(t) {
+                cbind(x = ages(t), y = mortalityImprovement(t, Period = Period))
+        });
+    }
+
+    list.names = names(data)
+    lns <- sapply(data, nrow)
+    data <- as.data.frame(do.call("rbind", data))
+    data$group <- rep(list.names, lns)
+    data
+}
+
+
+globalVariables(c("x", "y", ".x"))
+
+
+# mortalityTables.load("Austria_*")
+# plotMortalityTrend(AVOe1996R.male, AVOe1996R.female, AVOe2005R.male, AVOe2005R.female, YOB=1972, title="Austrian Annuity Tables, YOB=1972 (for cohort tables)")
+#
+# plotMortalityTables(mort.AT.census.2001.male, AVOe2005R.male, YOB=1972, title="Comparison Austrian Tables")
+#  plotMortalityTables(getCohortTable(AVOe2005R.male, YOB=1972), getCohortTable(AVOe2005R.male, YOB=2016), title="Comparison Austrian Tables")
+
+# plotMortalityTrend(EttlPagler.male@qx, AVOe1999P.male@qx, AVOe2008P.male@qx, YOB = 2003, title="Sterblichkeitstrends der Pagler-Tafeln")

man/plotMortalityTrend.Rd

+% Generated by roxygen2: do not edit by hand
+% Please edit documentation in R/plotMortalityTrend.R
+\name{plotMortalityTrend}
+\alias{plotMortalityTrend}
+\title{Plot the trends of multiple mortality tables (life tables) in one chart}
+\usage{
+plotMortalityTrend(data, ..., xlim = NULL, ylim = NULL, xlab = NULL,
+  ylab = NULL, title = "", legend.position = c(0.9, 0.1),
+  legend.key.width = unit(25, "mm"))
+}
+\arguments{
+\item{data}{First life table to be plotted. Either a \code{data.frame} generated by \code{makeQxDataFrame} or a \code{mortalityTable} object}
+
+\item{...}{Additional life tables to be plotted (if \code{data} is a \code{mortalityTable} object)}
+
+\item{xlim}{X-axis limitatation (as a two-element vector)}
+
+\item{ylim}{Y-axis limitatation (as a two-element vector)}
+
+\item{xlab}{X-axis label (default: "Alter")}
+
+\item{ylab}{Y-axis label (default: "Sterbewahrscheinlichkeit q_x relativ zu ....")}
+
+\item{title}{The plot title}
+
+\item{legend.position}{The position of the legend (default is \code{c(0.9,0.1)})}
+
+\item{legend.key.width}{The keywith of the lines in the  legend (default is \code{unit(25,"mm")})}
+}
+\description{
+\code{plotMortalityTrend} prints the trends of multiple life tables (objects
+of child classes of \code{mortalityTable}) in one plot, with a legend showing
+the names of the tables.
+}