Commit 17570bef authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

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)
parent e263c8b7
......@@ -52,6 +52,7 @@ Collate:
'plot.mortalityTable.R'
'plotMortalityTableComparisons.R'
'plotMortalityTables.R'
'plotMortalityTrend.R'
'setLoading.R'
'setModification.R'
'undampenTrend.R'
......
......@@ -24,6 +24,7 @@ export(pensionTables.list)
export(pensionTables.load)
export(plotMortalityTableComparisons)
export(plotMortalityTables)
export(plotMortalityTrend)
exportClasses(mortalityTable)
exportClasses(mortalityTable.ageShift)
exportClasses(mortalityTable.improvementFactors)
......
#' 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")
% 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.
}
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment