R/plot_predictive_distr_likelihood.R

In davewutchiett/nets_demo_spatial_dynamics: Predicting Change and Modeling Relationships In NYC Local Retail and Population.

#' plot empirical distribution of predictive performance across sets
library(plyr)
emp_pred_cdf = function(set = 'pa'){
  if (set == 'pa'){
    boot.validation.pa = readRDS('code/pavalidation.rds')
    valids = ldply(boot.validation.pa, function(x) rbind(x$t))
  } else if (set == 'hf') {
    boot.validation.hf = readRDS('code/hfvalidation.rds')
    valids = ldply(boot.validation.hf, function(x) rbind(x$t))
  } else if (set == 'pop') {
    boot.validation.pop = readRDS('code/popvalidation.rds')
    valids = ldply(boot.validation.pop, function(x) rbind(x$t))
  }
  pdf(file=paste('O:/', set, '_misclass.pdf', sep=''))
  par(oma=c(0,0,0,0))
  plot(ecdf(valids[,36]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'green',
    #main = 'Empirical Cumulative Distribution for Misclassification \nof 10yr Tract Population Increase in Resampled Withheld Data by \n Model Fit and Selection/Averaging Approaches', 
    main = '', xlab = '% Misclassified')
  lines(ecdf(valids[,6]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'blue')
  lines(ecdf(valids[,42]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'red')
  lines(ecdf(valids[,48]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'orange')
  lines(ecdf(valids[,18]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'gray')
  leg.loc = (min(valids[,36]) + .5*(max(valids[,36])-min(valids[,36])))
  legend(leg.loc, .2, c("Penalized Observed","Penalized Resampled Residual Deviance Min",
    "Unbiased Resampled Residual Deviance Min", "Unbiased Resampled Averaged", "Unbiased Observed"), 
    lty=c(1,1,1,1,1),lwd=c(2.5,2.5,2.5,2.5,2.5),col=c("blue",'gray',"orange","red",'green'), cex = .5, bty = "n")
  dev.off()
  pdf(file=paste('O:/', set, '_rdev.pdf', sep=''), width=400, height=400)
  par(oma=c(0,0,0,0))
  plot(ecdf(valids[,32]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'green',
    #main = 'Empirical Cumulative Distribution for Residual Deviance \nof 10yr Tract Physical Activity Facility Increase in Resampled Withheld Data by \n Model Fit and Selection/Averaging Approaches'
    main = '', xlab = 'Residual Deviance')
  lines(ecdf(valids[,2]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'blue')
  lines(ecdf(valids[,38]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'red')
  lines(ecdf(valids[,44]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'orange')
  lines(ecdf(valids[,14]), lty=1, lwd = 1, do.points = FALSE, verticals=T, col = 'gray')
  leg.loc = (min(valids[,32]) + .5*(max(valids[,32])-min(valids[,32])))
  legend( leg.loc, .2, c("Penalized Observed","Penalized Resampled Residual Deviance Min",
    "Unbiased Resampled Residual Deviance Min", "Unbiased Resampled Averaged", "Unbiased Observed"), 
    lty=c(1,1,1,1,1),lwd=c(2.5,2.5,2.5,2.5,2.5),col=c("blue",'gray',"orange","red",'green'), cex = .5, bty = "n")
  dev.off()
}
emp_pred_cdf(set = 'pa')
emp_pred_cdf(set = 'hf')
emp_pred_cdf(set = 'pop')