Commit beeaa415 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer

Add log and aes arguments to plotMortalityTables

Implement dimensional factors in the plot functions for table comparisons and for the trend
parent 7b3171b1
......@@ -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"),
......
......@@ -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"))
......
......@@ -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")
......@@ -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)}
......
......@@ -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.
......
......@@ -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