From beeaa415ac15c5d56167dcb8dd9f83956034bb3d Mon Sep 17 00:00:00 2001
From: Reinhold Kainhofer <reinhold@kainhofer.com>
Date: Tue, 22 May 2018 17:46:26 +0200
Subject: [PATCH] Add log and aes arguments to plotMortalityTables
Implement dimensional factors in the plot functions for table comparisons and for the trend
---
R/plotMortalityTableComparisons.R | 7 ++-
R/plotMortalityTables.R | 77 +++++++++++++----------
R/plotMortalityTrend.R | 94 ++++++++++++++++------------
man/plotMortalityTableComparisons.Rd | 6 +-
man/plotMortalityTables.Rd | 13 ++--
man/plotMortalityTrend.Rd | 10 +--
6 files changed, 122 insertions(+), 85 deletions(-)
diff --git a/R/plotMortalityTableComparisons.R b/R/plotMortalityTableComparisons.R
index cb6ca2a..7a0b19d 100644
--- a/R/plotMortalityTableComparisons.R
+++ b/R/plotMortalityTableComparisons.R
@@ -26,6 +26,7 @@
#' @export
plotMortalityTableComparisons = function(
data, ...,
+ aes = NULL,
ages = NULL,
xlim = NULL, ylim = NULL,
xlab = NULL, ylab = NULL,
@@ -56,7 +57,11 @@ plotMortalityTableComparisons = function(
env=list(refname=reference@name));
}
- pl = ggplot(data, aes(x = x, y = y, color = group)) +
+ pl = ggplot(data, aes(x = x, y = y, color = group))
+ if (!is.null(aes)) {
+ pl = pl + aes
+ }
+ pl = pl +
theme_bw() +
theme(
plot.title = element_text(size=18, face="bold"),
diff --git a/R/plotMortalityTables.R b/R/plotMortalityTables.R
index f18668b..981da9e 100644
--- a/R/plotMortalityTables.R
+++ b/R/plotMortalityTables.R
@@ -4,6 +4,7 @@
#'
#' @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 aes Optional aesthetics to append or override the default. The default aesthetics will always be applied first and provide defaults for x, y and color. This argument can be used to override the defaults or append other aesthetics.
#' @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")
@@ -14,6 +15,7 @@
#' @param legend.key.width The keywith of the lines in the legend (default is \code{unit(25,"mm")})
#' @param legend.title Title of the legend (\code{NULL} to hide)
#' @param ages Plot only the given ages
+#' @param log Display y axes in logarithmic scale (default: TRUE)
#'
#' @examples
#' # Load the Austrian census data
@@ -40,13 +42,15 @@
#' @export
plotMortalityTables = function(
data, ...,
+ aes = NULL,
ages = NULL,
legend.title = "Sterbetafel",
xlim=NULL, ylim=NULL,
xlab=NULL, ylab=NULL,
title = "",
legend.position = c(0.9,0.1), legend.justification = c(1, 0),
- legend.key.width = unit(25, "mm")
+ legend.key.width = unit(25, "mm"),
+ log = TRUE
) {
if (!is.data.frame(data)) {
data = makeQxDataFrame(data, ...);
@@ -58,40 +62,47 @@ plotMortalityTables = function(
if (!is.null(ages)) {
data = data[data$x %in% ages,]
}
- pl = ggplot(subset(data, y > 0), aes(x = x, y = y, colour = 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 = legend.justification, 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(na.rm = TRUE) +
- scale_y_log10(
- 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))
+ pl = ggplot(subset(data, y > 0), aes(x = x, y = y, color = group))
+ if (!is.null(aes)) {
+ pl = pl + aes
+ }
+ pl = pl +
+ theme_bw() +
+ theme(
+ plot.title = element_text(size = 14, face = "bold"),
+ legend.title = element_text(size = 12, face = "plain"),
+ # legend in bottom right corner of the plot
+ legend.justification = legend.justification, 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(na.rm = TRUE)
+
+ if (log) {
+ pl = pl + scale_y_log10(
+ 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)
+ ) +
+ annotation_logticks(sides = "lr")
+ }
+
+ pl = pl + scale_x_continuous(
+ name = xlab,
+ minor_breaks = function(limits) seq(max(round(min(limits)), 0), round(max(limits)), 1)
) +
- coord_cartesian(xlim = xlim, ylim = ylim) +
- annotation_logticks(sides = "lr") +
- xlab("Alter") + labs(colour = legend.title, shape = legend.title);
- if (title != "") {
- pl = pl + ggtitle(title);
- }
- pl
+ coord_cartesian(xlim = xlim, ylim = ylim) +
+ xlab("Alter") +
+ labs(colour = legend.title);
+ if (title != "") {
+ pl = pl + ggtitle(title);
+ }
+ pl
}
globalVariables(c("x", "y", ".x", "group"))
diff --git a/R/plotMortalityTrend.R b/R/plotMortalityTrend.R
index e385f76..9283f5b 100644
--- a/R/plotMortalityTrend.R
+++ b/R/plotMortalityTrend.R
@@ -6,6 +6,7 @@
#'
#' @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 aes Optional aesthetics to append or override the default. The default aesthetics will always be applied first and provide defaults for x, y and color. This argument can be used to override the defaults or append other aesthetics.
#' @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")
@@ -39,6 +40,7 @@
#' @export
plotMortalityTrend = function(
data, ...,
+ aes = NULL,
ages = NULL,
xlim=NULL, ylim=NULL,
xlab=NULL, ylab=NULL,
@@ -56,60 +58,70 @@ plotMortalityTrend = function(
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 = legend.justification, 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 = legend.title);
- if (title != "") {
- pl = pl + ggtitle(title);
- }
- pl
+ pl = ggplot(data, aes(x = x, y = y, color = group))
+ if (!is.null(aes)) {
+ pl = pl + aes
+ }
+ pl = pl +
+ 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 = legend.justification, 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) +
+ xlab("Alter") + labs(colour = legend.title);
+ if (title != "") {
+ pl = pl + ggtitle(title);
+ }
+ pl
}
makeMortalityTrendDataFrame = function(..., YOB = 1972, Period = NULL) {
# If reference is given, normalize all probabilities by that table!
data = unlist(list(...));
- names(data) = lapply(data, function(t) t@name);
+ if (is.null(data)) return(data.frame(x = double(), y = double(), group = character()))
+ # 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))
+ if (is.data.frame(t@data$dim) || is.list(t@data$dim)) {
+ data.frame(x = ages(t), y = `names<-`(mortalityImprovement(t, YOB = YOB), NULL), group = t@name, as.data.frame(t@data$dim))
+ } else {
+ data.frame(x = ages(t), y = `names<-`(mortalityImprovement(t, YOB = YOB), NULL), group = t@name)
+ }
});
} else {
data = lapply(data, function(t) {
- cbind(x = ages(t), y = mortalityImprovement(t, Period = Period))
+ if (is.data.frame(t@data$dim) || is.list(t@data$dim)) {
+ data.frame(x = ages(t), y = `names<-`(mortalityImprovement(t, Period = Period), NULL), group = t@name, as.data.frame(t@data$dim))
+ } else {
+ data.frame(x = ages(t), y = `names<-`(mortalityImprovement(t, Period = Period), NULL), group = t@name)
+ }
});
}
- list.names = names(data)
- lns <- sapply(data, nrow)
- data <- as.data.frame(do.call("rbind", data))
- data$group <- rep(list.names, lns)
+ names(data) = NULL
+ data <- as.data.frame(do.call("rbind.expand", data))
data
}
@@ -120,7 +132,7 @@ 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(mort.AT.census.2001.male, AVOe2005R.male, AVOe2005R.female, 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/plotMortalityTableComparisons.Rd b/man/plotMortalityTableComparisons.Rd
index 5acedb9..89766de 100644
--- a/man/plotMortalityTableComparisons.Rd
+++ b/man/plotMortalityTableComparisons.Rd
@@ -4,8 +4,8 @@
\alias{plotMortalityTableComparisons}
\title{Plot multiple mortality tables (life tables) in one plot, relative to a given reference table}
\usage{
-plotMortalityTableComparisons(data, ..., ages = NULL, xlim = NULL,
- ylim = NULL, xlab = NULL, ylab = NULL, title = "",
+plotMortalityTableComparisons(data, ..., aes = NULL, ages = NULL,
+ xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, title = "",
legend.position = c(0.9, 0.1), legend.justification = c(1, 0),
legend.title = "Sterbetafel", legend.key.width = unit(25, "mm"),
reference = NULL)
@@ -15,6 +15,8 @@ plotMortalityTableComparisons(data, ..., ages = NULL, xlim = NULL,
\item{...}{Additional life tables to be plotted (if \code{data} is a \code{mortalityTable} object)}
+\item{aes}{Optional aesthetics to append or override the default. The default aesthetics will always be applied first and provide defaults for x, y and color. This argument can be used to override the defaults or append other aesthetics.}
+
\item{ages}{Plot only the given ages}
\item{xlim}{X-axis limitatation (as a two-element vector)}
diff --git a/man/plotMortalityTables.Rd b/man/plotMortalityTables.Rd
index 58456ee..1ab331a 100644
--- a/man/plotMortalityTables.Rd
+++ b/man/plotMortalityTables.Rd
@@ -4,16 +4,19 @@
\alias{plotMortalityTables}
\title{Plot multiple mortality tables (life tables) in one plot}
\usage{
-plotMortalityTables(data, ..., ages = NULL, legend.title = "Sterbetafel",
- xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, title = "",
- legend.position = c(0.9, 0.1), legend.justification = c(1, 0),
- legend.key.width = unit(25, "mm"))
+plotMortalityTables(data, ..., aes = NULL, ages = NULL,
+ legend.title = "Sterbetafel", xlim = NULL, ylim = NULL, xlab = NULL,
+ ylab = NULL, title = "", legend.position = c(0.9, 0.1),
+ legend.justification = c(1, 0), legend.key.width = unit(25, "mm"),
+ log = TRUE)
}
\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{aes}{Optional aesthetics to append or override the default. The default aesthetics will always be applied first and provide defaults for x, y and color. This argument can be used to override the defaults or append other aesthetics.}
+
\item{ages}{Plot only the given ages}
\item{legend.title}{Title of the legend (\code{NULL} to hide)}
@@ -33,6 +36,8 @@ plotMortalityTables(data, ..., ages = NULL, legend.title = "Sterbetafel",
\item{legend.justification}{The justification of the legend (default is \code{c(1,)})}
\item{legend.key.width}{The keywith of the lines in the legend (default is \code{unit(25,"mm")})}
+
+\item{log}{Display y axes in logarithmic scale (default: TRUE)}
}
\description{
\code{plotMortalityTables} prints multiple life tables (objects of child classes of \code{mortalityTable}) in one log-linear plot, with a legend showing the names of the tables.
diff --git a/man/plotMortalityTrend.Rd b/man/plotMortalityTrend.Rd
index 6d67412..fc77cc3 100644
--- a/man/plotMortalityTrend.Rd
+++ b/man/plotMortalityTrend.Rd
@@ -4,16 +4,18 @@
\alias{plotMortalityTrend}
\title{Plot the trends of multiple mortality tables (life tables) in one chart}
\usage{
-plotMortalityTrend(data, ..., ages = NULL, xlim = NULL, ylim = NULL,
- xlab = NULL, ylab = NULL, title = "", legend.position = c(0.9, 0.9),
- legend.justification = c(1, 1), legend.title = "Sterbetafel",
- legend.key.width = unit(25, "mm"))
+plotMortalityTrend(data, ..., aes = NULL, ages = NULL, xlim = NULL,
+ ylim = NULL, xlab = NULL, ylab = NULL, title = "",
+ legend.position = c(0.9, 0.9), legend.justification = c(1, 1),
+ legend.title = "Sterbetafel", 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{aes}{Optional aesthetics to append or override the default. The default aesthetics will always be applied first and provide defaults for x, y and color. This argument can be used to override the defaults or append other aesthetics.}
+
\item{ages}{Plot only the given ages}
\item{xlim}{X-axis limitatation (as a two-element vector)}
--
GitLab