Add log and aes arguments to plotMortalityTables

Implement dimensional factors in the plot functions for table comparisons and for the trend

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"),

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"))

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")

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)}

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.

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)}