Skip to content

GitLab

R
R - Mortality Tables
Commit beeaa415 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer
Browse files
Options

Add log and aes arguments to plotMortalityTables 

Implement dimensional factors in the plot functions for table comparisons and for the trend
parent 7b3171b1
Hide whitespace changes
Inline Side-by-side
Showing with 122 additions and 85 deletions
R/plotMortalityTableComparisons.R
View file @ beeaa415
......@@ -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"),
......
R/plotMortalityTables.R
View file @ beeaa415
......@@ -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"))
......
R/plotMortalityTrend.R
View file @ beeaa415
......@@ -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")
man/plotMortalityTableComparisons.Rd
View file @ beeaa415
......@@ -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)}
......
man/plotMortalityTables.Rd
View file @ beeaa415
......@@ -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.
......
man/plotMortalityTrend.Rd
View file @ beeaa415
......@@ -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)}
......
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