plotMortalityTables.R 4.65 KB
Newer Older
1
#' Plot multiple mortality tables (life tables) in one plot
2
#'
3
#' \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
#'
5 6
#' @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)
7 8 9 10
#' @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")
#' @param ylab Y-axis label (default: "Sterbewahrscheinlichkeit q_x relativ zu ....")
11 12
#' @param title The plot title
#' @param legend.position The position of the legend (default is \code{c(0.9,0.1)})
13
#' @param legend.justification The justification of the legend (default is \code{c(1,)})
14
#' @param legend.key.width The keywith of the lines in the  legend (default is \code{unit(25,"mm")})
15
#' @param legend.title Title of the legend (\code{NULL} to hide)
16
#' @param ages Plot only the given ages
17
#'
18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
#' @examples
#' # Load the Austrian census data
#' mortalityTables.load("Austria_Annuities")
#' mortalityTables.load("Austria_Census")
#'
#' # Plot some select census tables in a log-linear plot (plot called
#' # with mortalityTable objects is equla to calling plotMortalitytTables directly)
#' plot(mort.AT.census.1869.male, mort.AT.census.1869.female,
#'      mort.AT.census.1971.male, mort.AT.census.1971.female,
#'      mort.AT.census.2011.male, mort.AT.census.2011.female,
#'      title="Austrian census tables",
#'      ylab=expression(q[x]), xlab="Age",
#'      xlim=c(0,90),
#'      legend.position=c(0.95,0.05))
#'
#' # To compare period or cohort life tables, use the YOB and Period arguments:
#' plot(AVOe2005R.male, AVOe2005R.female, AVOe1996R.male, AVOe1996R.female,
#'     Period = 2018, title = "Austrian Annuity Tables, Period 2018")
#' plot(AVOe2005R.male, AVOe2005R.female, AVOe1996R.male, AVOe1996R.female,
#'     YOB = 2000, title = "Austrian Annuity Tables for cohort YOB=2000")
#'
39
#' @import scales
40
#' @export
41 42
plotMortalityTables = function(
    data, ...,
43
    ages = NULL,
44 45 46 47 48 49 50 51 52 53 54 55
    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")
) {
    if (!is.data.frame(data)) {
        data = makeQxDataFrame(data, ...);
    }
    if (missing(xlab)) xlab = "Alter";
    if (missing(ylab)) ylab = expression(paste("Sterbewahrscheinlichkeit ", q[x]));
56

57 58 59 60 61
    data = subset(data, y > 0)
    if (!is.null(ages)) {
        data = data[data$x %in% ages,]
    }
    pl = ggplot(subset(data, y > 0), aes(x = x, y = y, colour = group, shape = group)) +
62 63
    theme_bw() +
    theme(
64 65
      plot.title = element_text(size = 18, face = "bold"),
      legend.title = element_text(size = 14, face = "bold.italic"),
66
      # legend in bottom right corner of the plot
67
      legend.justification = legend.justification, legend.position = legend.position,
68 69 70
      # No box around legend entries
      legend.key = element_blank(),
      legend.key.width = legend.key.width,
71
      legend.background = element_rect(colour = "gray50", linetype = "solid")
72
    ) +
73
    geom_line(na.rm = TRUE) +
74
    scale_y_log10(
75
      name = ylab,
76 77 78 79 80
      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(
81
      name = xlab,
82
      #breaks = function (limits) scales::trans_breaks('', function(x) 10^x),
83
      # breaks = function (limits) seq(max(min(limits),0),max(limits),5),
84
      minor_breaks = function(limits) seq(max(round(min(limits)), 0), round(max(limits)), 1)
85 86 87
      #labels = scales::trans_format('log10', scales::math_format(10^.x))

    ) +
88 89 90
    coord_cartesian(xlim = xlim, ylim = ylim) +
    annotation_logticks(sides = "lr") +
    xlab("Alter") + labs(colour = legend.title, shape = legend.title);
91 92 93 94 95
  if (title != "") {
    pl = pl + ggtitle(title);
  }
  pl
}
96

97
globalVariables(c("x", "y", ".x", "group"))
98

99

100
#
101
# plotMortalityTables(mort.AT.census.1869.male, mort.AT.census.1869.female, mort.AT.census.2011.male, mort.AT.census.2011.female, AVOe2005R.male, AVOe2005R.female, YOB=1972,title="Austrian Tables, YOB=1972 (for cohort tables)")
102
#
103 104
# plotMortalityTables(mort.AT.census.2001.male, AVOe2005R.male, YOB=1972, title="Comparison Austrian Tables")
#  plotMortalityTables(getCohortTable(AVOe2005R.male, YOB=1972), getCohortTable(AVOe2005R.male, YOB=2016), title="Comparison Austrian Tables")