Skip to content
Snippets Groups Projects
Commit beeaa415 authored by Reinhold Kainhofer's avatar Reinhold Kainhofer
Browse files

Add log and aes arguments to plotMortalityTables

Implement dimensional factors in the plot functions for table comparisons and for the trend
parent 7b3171b1
Branches
Tags
No related merge requests found
...@@ -26,6 +26,7 @@ ...@@ -26,6 +26,7 @@
#' @export #' @export
plotMortalityTableComparisons = function( plotMortalityTableComparisons = function(
data, ..., data, ...,
aes = NULL,
ages = NULL, ages = NULL,
xlim = NULL, ylim = NULL, xlim = NULL, ylim = NULL,
xlab = NULL, ylab = NULL, xlab = NULL, ylab = NULL,
...@@ -56,7 +57,11 @@ plotMortalityTableComparisons = function( ...@@ -56,7 +57,11 @@ plotMortalityTableComparisons = function(
env=list(refname=reference@name)); 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_bw() +
theme( theme(
plot.title = element_text(size=18, face="bold"), plot.title = element_text(size=18, face="bold"),
......
...@@ -4,6 +4,7 @@ ...@@ -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 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 ... 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 xlim X-axis limitatation (as a two-element vector)
#' @param ylim Y-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 xlab X-axis label (default: "Alter")
...@@ -14,6 +15,7 @@ ...@@ -14,6 +15,7 @@
#' @param legend.key.width The keywith of the lines in the legend (default is \code{unit(25,"mm")}) #' @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 legend.title Title of the legend (\code{NULL} to hide)
#' @param ages Plot only the given ages #' @param ages Plot only the given ages
#' @param log Display y axes in logarithmic scale (default: TRUE)
#' #'
#' @examples #' @examples
#' # Load the Austrian census data #' # Load the Austrian census data
...@@ -40,13 +42,15 @@ ...@@ -40,13 +42,15 @@
#' @export #' @export
plotMortalityTables = function( plotMortalityTables = function(
data, ..., data, ...,
aes = NULL,
ages = NULL, ages = NULL,
legend.title = "Sterbetafel", legend.title = "Sterbetafel",
xlim=NULL, ylim=NULL, xlim=NULL, ylim=NULL,
xlab=NULL, ylab=NULL, xlab=NULL, ylab=NULL,
title = "", title = "",
legend.position = c(0.9,0.1), legend.justification = c(1, 0), 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)) { if (!is.data.frame(data)) {
data = makeQxDataFrame(data, ...); data = makeQxDataFrame(data, ...);
...@@ -58,40 +62,47 @@ plotMortalityTables = function( ...@@ -58,40 +62,47 @@ plotMortalityTables = function(
if (!is.null(ages)) { if (!is.null(ages)) {
data = data[data$x %in% 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) + coord_cartesian(xlim = xlim, ylim = ylim) +
annotation_logticks(sides = "lr") + xlab("Alter") +
xlab("Alter") + labs(colour = legend.title, shape = legend.title); labs(colour = legend.title);
if (title != "") { if (title != "") {
pl = pl + ggtitle(title); pl = pl + ggtitle(title);
} }
pl pl
} }
globalVariables(c("x", "y", ".x", "group")) globalVariables(c("x", "y", ".x", "group"))
......
...@@ -6,6 +6,7 @@ ...@@ -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 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 ... 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 xlim X-axis limitatation (as a two-element vector)
#' @param ylim Y-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 xlab X-axis label (default: "Alter")
...@@ -39,6 +40,7 @@ ...@@ -39,6 +40,7 @@
#' @export #' @export
plotMortalityTrend = function( plotMortalityTrend = function(
data, ..., data, ...,
aes = NULL,
ages = NULL, ages = NULL,
xlim=NULL, ylim=NULL, xlim=NULL, ylim=NULL,
xlab=NULL, ylab=NULL, xlab=NULL, ylab=NULL,
...@@ -56,60 +58,70 @@ plotMortalityTrend = function( ...@@ -56,60 +58,70 @@ plotMortalityTrend = function(
if (missing(xlab)) xlab = "Alter"; if (missing(xlab)) xlab = "Alter";
if (missing(ylab)) ylab = expression(paste("Sterblichkeitstrend ", lambda[x])); if (missing(ylab)) ylab = expression(paste("Sterblichkeitstrend ", lambda[x]));
pl = ggplot(data, aes(x = x, y = y, colour = data$group)) + pl = ggplot(data, aes(x = x, y = y, color = group))
theme_bw() + if (!is.null(aes)) {
theme( pl = pl + aes
plot.title = element_text(size = 18, face = "bold"), }
legend.title = element_text(size = 14, face = "bold.italic"), pl = pl +
# legend in bottom right corner of the plot theme_bw() +
legend.justification = legend.justification, legend.position = legend.position, theme(
# No box around legend entries plot.title = element_text(size = 18, face = "bold"),
legend.key = element_blank(), legend.title = element_text(size = 14, face = "bold.italic"),
legend.key.width = legend.key.width, # legend in bottom right corner of the plot
legend.background = element_rect(colour = "gray50", linetype = "solid") legend.justification = legend.justification, legend.position = legend.position,
) + # No box around legend entries
geom_line() + legend.key = element_blank(),
scale_y_continuous( legend.key.width = legend.key.width,
name = ylab, legend.background = element_rect(colour = "gray50", linetype = "solid")
# breaks = scales::trans_breaks('log10', function(x) 10^x), ) +
# labels = scales::trans_format('log10', scales::math_format(10^.x)) geom_line() +
#minor_breaks = log(c(sapply(x, function(x) seq(0, x, x/10))), 10) scale_y_continuous(
) + name = ylab,
scale_x_continuous( # breaks = scales::trans_breaks('log10', function(x) 10^x),
name = xlab, # labels = scales::trans_format('log10', scales::math_format(10^.x))
#breaks = function (limits) scales::trans_breaks('', function(x) 10^x), #minor_breaks = log(c(sapply(x, function(x) seq(0, x, x/10))), 10)
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) scale_x_continuous(
#labels = scales::trans_format('log10', scales::math_format(10^.x)) name = xlab,
) + #breaks = function (limits) scales::trans_breaks('', function(x) 10^x),
coord_cartesian(xlim = xlim, ylim = ylim) + breaks = function(limits) seq(max(min(limits), 0), max(limits), 5),
annotation_logticks(sides = "lr") + minor_breaks = function(limits) seq(max(round(min(limits)), 0), round(max(limits)), 1)
xlab("Alter") + labs(colour = legend.title); #labels = scales::trans_format('log10', scales::math_format(10^.x))
if (title != "") { ) +
pl = pl + ggtitle(title); coord_cartesian(xlim = xlim, ylim = ylim) +
} xlab("Alter") + labs(colour = legend.title);
pl if (title != "") {
pl = pl + ggtitle(title);
}
pl
} }
makeMortalityTrendDataFrame = function(..., YOB = 1972, Period = NULL) { makeMortalityTrendDataFrame = function(..., YOB = 1972, Period = NULL) {
# If reference is given, normalize all probabilities by that table! # If reference is given, normalize all probabilities by that table!
data = unlist(list(...)); 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)) { if (missing(Period) || is.null(Period)) {
data = lapply(data, function(t) { 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 { } else {
data = lapply(data, function(t) { 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) names(data) = NULL
lns <- sapply(data, nrow) data <- as.data.frame(do.call("rbind.expand", data))
data <- as.data.frame(do.call("rbind", data))
data$group <- rep(list.names, lns)
data data
} }
...@@ -120,7 +132,7 @@ globalVariables(c("x", "y", ".x")) ...@@ -120,7 +132,7 @@ globalVariables(c("x", "y", ".x"))
# mortalityTables.load("Austria_*") # mortalityTables.load("Austria_*")
# plotMortalityTrend(AVOe1996R.male, AVOe1996R.female, AVOe2005R.male, AVOe2005R.female, YOB=1972, title="Austrian Annuity Tables, YOB=1972 (for cohort tables)") # 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") # 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") # plotMortalityTrend(EttlPagler.male@qx, AVOe1999P.male@qx, AVOe2008P.male@qx, YOB = 2003, title="Sterblichkeitstrends der Pagler-Tafeln")
...@@ -4,8 +4,8 @@ ...@@ -4,8 +4,8 @@
\alias{plotMortalityTableComparisons} \alias{plotMortalityTableComparisons}
\title{Plot multiple mortality tables (life tables) in one plot, relative to a given reference table} \title{Plot multiple mortality tables (life tables) in one plot, relative to a given reference table}
\usage{ \usage{
plotMortalityTableComparisons(data, ..., ages = NULL, xlim = NULL, plotMortalityTableComparisons(data, ..., aes = NULL, ages = NULL,
ylim = NULL, xlab = NULL, ylab = NULL, title = "", xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, title = "",
legend.position = c(0.9, 0.1), legend.justification = c(1, 0), legend.position = c(0.9, 0.1), legend.justification = c(1, 0),
legend.title = "Sterbetafel", legend.key.width = unit(25, "mm"), legend.title = "Sterbetafel", legend.key.width = unit(25, "mm"),
reference = NULL) reference = NULL)
...@@ -15,6 +15,8 @@ plotMortalityTableComparisons(data, ..., ages = NULL, xlim = 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{...}{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{ages}{Plot only the given ages}
\item{xlim}{X-axis limitatation (as a two-element vector)} \item{xlim}{X-axis limitatation (as a two-element vector)}
......
...@@ -4,16 +4,19 @@ ...@@ -4,16 +4,19 @@
\alias{plotMortalityTables} \alias{plotMortalityTables}
\title{Plot multiple mortality tables (life tables) in one plot} \title{Plot multiple mortality tables (life tables) in one plot}
\usage{ \usage{
plotMortalityTables(data, ..., ages = NULL, legend.title = "Sterbetafel", plotMortalityTables(data, ..., aes = NULL, ages = NULL,
xlim = NULL, ylim = NULL, xlab = NULL, ylab = NULL, title = "", legend.title = "Sterbetafel", xlim = NULL, ylim = NULL, xlab = NULL,
legend.position = c(0.9, 0.1), legend.justification = c(1, 0), ylab = NULL, title = "", legend.position = c(0.9, 0.1),
legend.key.width = unit(25, "mm")) legend.justification = c(1, 0), legend.key.width = unit(25, "mm"),
log = TRUE)
} }
\arguments{ \arguments{
\item{data}{First life table to be plotted. Either a \code{data.frame} generated by \code{makeQxDataFrame} or a \code{mortalityTable} object} \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{...}{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{ages}{Plot only the given ages}
\item{legend.title}{Title of the legend (\code{NULL} to hide)} \item{legend.title}{Title of the legend (\code{NULL} to hide)}
...@@ -33,6 +36,8 @@ plotMortalityTables(data, ..., ages = NULL, legend.title = "Sterbetafel", ...@@ -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.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{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{ \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. \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 @@ ...@@ -4,16 +4,18 @@
\alias{plotMortalityTrend} \alias{plotMortalityTrend}
\title{Plot the trends of multiple mortality tables (life tables) in one chart} \title{Plot the trends of multiple mortality tables (life tables) in one chart}
\usage{ \usage{
plotMortalityTrend(data, ..., ages = NULL, xlim = NULL, ylim = NULL, plotMortalityTrend(data, ..., aes = NULL, ages = NULL, xlim = NULL,
xlab = NULL, ylab = NULL, title = "", legend.position = c(0.9, 0.9), ylim = NULL, xlab = NULL, ylab = NULL, title = "",
legend.justification = c(1, 1), legend.title = "Sterbetafel", legend.position = c(0.9, 0.9), legend.justification = c(1, 1),
legend.key.width = unit(25, "mm")) legend.title = "Sterbetafel", legend.key.width = unit(25, "mm"))
} }
\arguments{ \arguments{
\item{data}{First life table to be plotted. Either a \code{data.frame} generated by \code{makeQxDataFrame} or a \code{mortalityTable} object} \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{...}{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{ages}{Plot only the given ages}
\item{xlim}{X-axis limitatation (as a two-element vector)} \item{xlim}{X-axis limitatation (as a two-element vector)}
......
0% Loading or .
You are about to add 0 people to the discussion. Proceed with caution.
Please register or to comment