diff --git a/DESCRIPTION b/DESCRIPTION index ae71c9322d591a65b6fe75b70069d0abe311dfea..68fd0ddc0641c150fd9c95a53d72023632528e72 100644 --- a/DESCRIPTION +++ b/DESCRIPTION @@ -52,6 +52,7 @@ Collate: 'plot.mortalityTable.R' 'plotMortalityTableComparisons.R' 'plotMortalityTables.R' + 'plotMortalityTrend.R' 'setLoading.R' 'setModification.R' 'undampenTrend.R' diff --git a/NAMESPACE b/NAMESPACE index b72be70efb216965aa2ca46b2298082af8969fbb..38e64ed6aff597f84b7e66ff662f0c1852be2338 100644 --- a/NAMESPACE +++ b/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) diff --git a/R/plotMortalityTrend.R b/R/plotMortalityTrend.R new file mode 100644 index 0000000000000000000000000000000000000000..eb3ae4ce2f95b3382068084fb26527aa42d9ebef --- /dev/null +++ b/R/plotMortalityTrend.R @@ -0,0 +1,93 @@ +#' 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") diff --git a/man/plotMortalityTrend.Rd b/man/plotMortalityTrend.Rd new file mode 100644 index 0000000000000000000000000000000000000000..fb4e8a074bfb2084e1948f49d7cf5484c5c732ba --- /dev/null +++ b/man/plotMortalityTrend.Rd @@ -0,0 +1,34 @@ +% 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. +}