R/plotting.R

Defines functions plot_mean plot_stacked plot_stacked_normalized

#' @export
plot_stacked_normalized = function(age_profiles, year_range, name, plot_categories = c()) {
  location = file.path('plots', name, 'stacked_normalized')
  print(paste("Plotting stacked, normalized line graph in", location))
  dir.create(location, recursive = TRUE, showWarnings = FALSE)
  do.call(file.remove, list(list.files(location, full.names = TRUE)))
  last_obs_year = c(0, 0)
  for (y in year_range) {
    tikz(file.path(location, paste(y, '.tex', sep = '')), width = 8, height = 6, standAlone = TRUE)
    par(mfrow = c(1, length(age_profiles)))
    age_profile_index = 1
    for (age_profile in age_profiles) {
      stack = rep(0, length(seq(19, 79)))
      plot(1, type="n", xlab="Age", ylab="Percent of total population", bty = "n", xlim=c(18, 79), xaxt = "n", yaxt = "n", ylim=c(0, 1))
      if (age_profile[age > 18 & year == y]$total_in_year[1] == 0) {
        year_to_use = last_obs_year[age_profile_index]
      } else {
        last_obs_year[age_profile_index] = y
        year_to_use = y
      }
      to_plot = age_profile[age > 18 & year == year_to_use]
      col = 1
      for (category in plot_categories) {
        quant = paste("cat_perc_", category, sep = '')
        new_stack = stack + to_plot[name == quant]$val
        polygon(c(to_plot[name == quant]$age, rev(to_plot[name == quant]$age)), c(stack, rev(new_stack)), col = rainbow(length(plot_categories))[col])
        stack = new_stack
        col = col + 1
      }
      axis(2, mgp=c(2.5, 0.6, 0.5), cex = 0.25)
      axis(1, pos = 0, cex = 0.25)
      legend("topright", NULL, plot_categories, col = rainbow(length(plot_categories)), lwd = 2, cex = 0.6, bg = "white")
      title(year_to_use)
      age_profile_index = age_profile_index + 1
    }
    dev.off()
  }
  compile_latex(location)
  make_animation(location)
  clean_dir(location)
}

#' @export
plot_stacked = function(age_profiles, year_range, name, plot_categories = c(), stacked_ylim = c(0, 1)) {
  location = file.path('plots', name, 'stacked')
  print(paste("Plotting stacked line graph in", location))
  dir.create(location, recursive = TRUE, showWarnings = FALSE)
  do.call(file.remove, list(list.files(location, full.names = TRUE)))
  last_obs_year = c(0, 0)
  for (y in year_range) {
    tikz(file.path(location, paste(y, '.tex', sep = '')), width = 8, height = 6, standAlone = TRUE)
    par(mfrow = c(1, length(age_profiles)))
    age_profile_index = 1
    for (age_profile in age_profiles) {
      stack = rep(0, length(seq(19, 79)))
      plot(1, type="n", xlab="Age", ylab="Percent of total population", bty = "n", xlim=c(18, 79), xaxt = "n", yaxt = "n", ylim=stacked_ylim)
      if (age_profile[age > 18 & year == y]$total_in_year[1] == 0) {
        year_to_use = last_obs_year[age_profile_index]
      } else {
        last_obs_year[age_profile_index] = y
        year_to_use = y
      }
      to_plot = age_profile[age > 18 & year == year_to_use]
      col = 1
      for (category in plot_categories) {
        quant = paste("cat_sum_", category, sep = '')
        quant_all = paste("cat_all_", category, sep = '')
        new_stack = stack + to_plot[name == quant]$val / to_plot[name == quant_all]$val[1]
        polygon(c(to_plot[name == quant]$age, rev(to_plot[name == quant]$age)), c(stack, rev(new_stack)), col = rainbow(length(plot_categories))[col])
        stack = new_stack
        col = col + 1
      }
      axis(2, mgp=c(2.5, 0.6, 0.5), cex = 0.25)
      axis(1, pos = 0, cex = 0.25)
      legend("topright", NULL, plot_categories, col = rainbow(length(plot_categories)), lwd = 2, cex = 0.6, bty = "n")
      title(year_to_use)
      age_profile_index = age_profile_index + 1
    }
    dev.off()
  }
  compile_latex(location)
  make_animation(location)
  clean_dir(location)
}

#' @export
plot_mean = function(age_profiles, year_range, ylim, name) {
  # plot mean
  location = file.path('plots', name, 'means')
  dir.create(location, recursive = TRUE, showWarnings = FALSE)
  do.call(file.remove, list(list.files(location, full.names = TRUE)))
  for (year in year_range) {
    tikz(file.path(location, paste(year, '.tex', sep = '')), width = 6, height = 4, standAlone = TRUE)
    par(mfrow = c(1, length(age_profiles)))
    for (age_profile in age_profiles) {
      to_plot = age_profile[age > 18 & year == year]
      plot(to_plot[name == "mean"]$age, to_plot[name == "mean"]$val, xlab = "Age", ylab = name, xlim = c(18, 100), ylim = ylim, bty="n", xaxt = "n", yaxt = "n", type = 'l', lwd = 2)
      lines(to_plot[name == "mean"]$age, to_plot[name == "mean"]$val + 1.96*sqrt(to_plot[name == "var"]$val), lwd = 0.5)
      lines(to_plot[name == "mean"]$age, to_plot[name == "mean"]$val - 1.96*sqrt(to_plot[name == "var"]$val), lwd = 0.5)
      title(year)
      axis(2, mgp=c(2.5, 0.6, 0.5), cex = 0.25)
      axis(1, pos = 0, cex = 0.25)
    }
    dev.off()
  }
  compile_latex(location)
  make_animation(location)
  clean_dir(location)

  # plot means superimposed
  location = file.path('plots', name, 'mean_super')
  dir.create(location, recursive = TRUE, showWarnings = FALSE)
  do.call(file.remove, list(list.files(location, full.names = TRUE)))
  for (year in year_range) {
    tikz(file.path(location, paste(year, '.tex', sep = '')), width = 6, height = 4, standAlone = TRUE)
    par(mfrow = c(1, 1))
    plot(1, xlab = "Age", ylab = name, xlim = c(18, 100), ylim = ylim, bty="n", xaxt = "n", yaxt = "n")
    col = 1
    for (age_profile in age_profiles) {
      to_plot = age_profile[age > 18 & year == year]
      lines(to_plot[name == "mean"]$age, to_plot[name == "mean"]$val, lwd = 2, col = rainbow(2)[col])
      lines(to_plot[name == "mean"]$age, to_plot[name == "mean"]$val + 1.96*sqrt(to_plot[name == "var"]$val), lwd = 0.5, col = rainbow(2)[col])
      lines(to_plot[name == "mean"]$age, to_plot[name == "mean"]$val - 1.96*sqrt(to_plot[name == "var"]$val), lwd = 0.5, col = rainbow(2)[col])
      col = col + 1
    }
    title(year)
    axis(2, mgp=c(2.5, 0.6, 0.5), cex = 0.25)
    axis(1, pos = 0, cex = 0.25)
    dev.off()
  }
  compile_latex(location)
  make_animation(location)
  clean_dir(location)
}
penn-wharton-budget-model/plotsim documentation built on Aug. 19, 2017, 12:17 a.m.