
R Under development (unstable) (2014-06-02 r65832) -- "Unsuffered Consequences"
Copyright (C) 2014 The R Foundation for Statistical Computing
Platform: x86_64-apple-darwin10.8.0 (64-bit)

R is free software and comes with ABSOLUTELY NO WARRANTY.
You are welcome to redistribute it under certain conditions.
Type 'license()' or 'licence()' for distribution details.

  Natural language support but running in an English locale

R is a collaborative project with many contributors.
Type 'contributors()' for more information and
'citation()' on how to cite R or R packages in publications.

Type 'demo()' for some demos, 'help()' for on-line help, or
'help.start()' for an HTML browser interface to help.
Type 'q()' to quit R.

> ################################################################################
> ### R code from Applied Predictive Modeling (2013) by Kuhn and Johnson.
> ### Copyright 2013 Kuhn and Johnson
> ### Web Page: http://www.appliedpredictivemodeling.com
> ### Contact: Max Kuhn (mxkuhn@gmail.com) 
> ###
> ### R code to process the Kaggle grant application data.
> ###
> ### Required packages: plyr, caret, lubridate
> ###                   
> ###
> ### Data used: The file unimelb_training.csv
> ###
> ### Notes: 
> ### 1) This code is provided without warranty.
> ###
> ### 2) This code should help the user reproduce the results in the
> ### text. There will be differences between this code and what is is
> ### the computing section. For example, the computing sections show
> ### how the source functions work (e.g. randomForest() or plsr()),
> ### which were not directly used when creating the book. Also, there may be 
> ### syntax differences that occur over time as packages evolve. These files 
> ### will reflect those changes.
> ###
> ### 3) In some cases, the calculations in the book were run in 
> ### parallel. The sub-processes may reset the random number seed.
> ### Your results may slightly vary.
> ###
> ################################################################################
> 
> ## The plyr, caret and libridate packages are used in this script. The
> ## code can also be run using multiple cores using the ddply()
> ## function. See ?ddply to get more information.
> ##
> ## The user will need the unimelb_training.csv file from the
> ## competition.
> ##
> ## These computations will take a fair amount of time and may consume
> ## a non-trivial amount of memory in the process.
> ##
> 
> ## Load required libraries
> library(plyr)
> library(caret)
Loading required package: lattice
Loading required package: ggplot2
> library(lubridate)

Attaching package: 'lubridate'

The following object is masked from 'package:plyr':

    here

> 
> ## How many cores on the machine should be used for the data
> ## processing. Making cores > 1 will speed things up (depending on your
> ## machine) but will consume more memory.
> cores <- 3
> 
> if(cores > 1) {
+     library(doMC)
+     registerDoMC(cores)
+   }
Loading required package: foreach
Loading required package: iterators
Loading required package: parallel
> 
> ## Read in the data in it's raw form. Some of the column headings do
> ## not convert to proper R variable names, so many will contain dots,
> ## such as "Dept.No" instead of "Dept No"
> raw <- read.csv("unimelb_training.csv")
> 
> ## In many cases, missing values in categorical data will be converted
> ## to a value of "Unk"
> raw$Sponsor.Code <- as.character(raw$Sponsor.Code)
> raw$Sponsor.Code[raw$Sponsor.Code == ""] <- "Unk"
> raw$Sponsor.Code <- factor(paste("Sponsor", raw$Sponsor.Code, sep = ""))
> 
> raw$Grant.Category.Code <- as.character(raw$Grant.Category.Code)
> raw$Grant.Category.Code[raw$Grant.Category.Code == ""] <- "Unk"
> raw$Grant.Category.Code <- factor(paste("GrantCat", raw$Grant.Category.Code, sep = ""))
> 
> raw$Contract.Value.Band...see.note.A <- as.character(raw$Contract.Value.Band...see.note.A)
> raw$Contract.Value.Band...see.note.A[raw$Contract.Value.Band...see.note.A == ""] <- "Unk"
> raw$Contract.Value.Band...see.note.A <- factor(paste("ContractValueBand", raw$Contract.Value.Band...see.note.A, sep = ""))
> 
> ## Change missing Role.1 information to Unk
> raw$Role.1 <- as.character(raw$Role.1)
> raw$Role.1[raw$Role.1 == ""] <- "Unk"
> 
> ## Get the unique values of the birth years and department
> ## codes. These will be used later to make factor variables
> bYears <- unique(do.call("c", raw[,grep("Year.of.Birth", names(raw), fixed = TRUE)]))
> bYears <- bYears[!is.na(bYears)]
> 
> dpmt <- unique(do.call("c", raw[,grep("Dept.No", names(raw), fixed = TRUE)]))
> dpmt <- sort(dpmt[!is.na(dpmt)])
> 
> ## At this point, the data for investigators is in different
> ## columns. We'll take this "horizontal" format and convert it to a
> ## "vertical" format where the data are stacked. This will make some
> ## of the data processing easier.
> 
> ## Split up the data by role number (1-15) and add any missing columns
> ## (roles 1-5 have more columns than the others)
> tmp <- vector(mode = "list", length = 15)
> for(i in 1:15) {
+     tmpData <- raw[, c("Grant.Application.ID", grep(paste("\\.", i, "$", sep = ""), names(raw), value = TRUE))]
+     names(tmpData) <- gsub(paste("\\.", i, "$", sep = ""), "", names(tmpData))
+     if(i == 1) nms <- names(tmpData)
+     if(all(names(tmpData) != "RFCD.Code")) tmpData$RFCD.Code <- NA
+     if(all(names(tmpData) != "RFCD.Percentage")) tmpData$RFCD.Percentage <- NA
+     if(all(names(tmpData) != "SEO.Code")) tmpData$SEO.Code <- NA
+     if(all(names(tmpData) != "SEO.Percentage")) tmpData$SEO.Percentage <- NA
+ 
+     tmp[[i]] <- tmpData[,nms]
+     rm(tmpData)
+   }
> ## Stack them up and remove any rows without role information
> vertical <- do.call("rbind", tmp)
> vertical <- subset(vertical, Role != "")
> 
> ## Reformat some of the variables to make complete factors, correctly
> ## encode missing data or to make the factor levels more descriptive.
> 
> vertical$Role <- factor(as.character(vertical$Role))
> 
> vertical$Year.of.Birth <- factor(paste(vertical$Year.of.Birth), levels = paste(sort(bYears)))
> vertical$Country.of.Birth <- gsub(" ", "", as.character(vertical$Country.of.Birth))
> vertical$Country.of.Birth[vertical$Country.of.Birth == ""] <- NA
> vertical$Country.of.Birth <- factor(vertical$Country.of.Birth)
> 
> vertical$Home.Language <- gsub("Other", "OtherLang", as.character(vertical$Home.Language))
> vertical$Home.Language[vertical$Home.Language == ""] <- NA
> vertical$Home.Language <- factor(vertical$Home.Language)
> 
> vertical$Dept.No. <- paste("Dept", vertical$Dept.No., sep = "")
> vertical$Dept.No.[vertical$Dept.No. == "DeptNA"] <- NA
> vertical$Dept.No. <- factor(vertical$Dept.No.)
> 
> vertical$Faculty.No. <- paste("Faculty", vertical$Faculty.No., sep = "")
> vertical$Faculty.No.[vertical$Faculty.No. == "FacultyNA"] <- NA
> vertical$Faculty.No. <- factor(vertical$Faculty.No.)
> 
> vertical$RFCD.Code <- paste("RFCD", vertical$RFCD.Code, sep = "")
> vertical$RFCD.Percentage[vertical$RFCD.Code == "RFCDNA"] <- NA
> vertical$RFCD.Code[vertical$RFCD.Code == "RFCDNA"] <- NA
> vertical$RFCD.Percentage[vertical$RFCD.Code == "RFCD0"] <- NA
> vertical$RFCD.Code[vertical$RFCD.Code == "RFCD0"] <- NA
> vertical$RFCD.Percentage[vertical$RFCD.Code == "RFCD999999"] <- NA
> vertical$RFCD.Code[vertical$RFCD.Code == "RFCD999999"] <- NA
> vertical$RFCD.Code <- factor(vertical$RFCD.Code)
> 
> vertical$SEO.Code <- paste("SEO", vertical$SEO.Code, sep = "")
> vertical$SEO.Percentage[vertical$SEO.Code == "SEONA"] <- NA
> vertical$SEO.Code[vertical$SEO.Code == "SEONA"] <- NA
> vertical$SEO.Percentage[vertical$SEO.Code == "SEO0"] <- NA
> vertical$SEO.Code[vertical$SEO.Code  == "SEO0"] <- NA
> vertical$SEO.Percentage[vertical$SEO.Code == "SEO999999"] <- NA
> vertical$SEO.Code[vertical$SEO.Code== "SEO999999"] <- NA
> vertical$SEO.Code <- factor(vertical$SEO.Code)
> 
> vertical$No..of.Years.in.Uni.at.Time.of.Grant <- as.character(vertical$No..of.Years.in.Uni.at.Time.of.Grant)
> vertical$No..of.Years.in.Uni.at.Time.of.Grant[vertical$No..of.Years.in.Uni.at.Time.of.Grant == ""] <- "DurationUnk"
> vertical$No..of.Years.in.Uni.at.Time.of.Grant[vertical$No..of.Years.in.Uni.at.Time.of.Grant == ">=0 to 5"] <- "Duration0to5"
> vertical$No..of.Years.in.Uni.at.Time.of.Grant[vertical$No..of.Years.in.Uni.at.Time.of.Grant == ">5 to 10"] <- "Duration5to10"
> vertical$No..of.Years.in.Uni.at.Time.of.Grant[vertical$No..of.Years.in.Uni.at.Time.of.Grant == ">10 to 15"] <- "Duration10to15"
> vertical$No..of.Years.in.Uni.at.Time.of.Grant[vertical$No..of.Years.in.Uni.at.Time.of.Grant == "more than 15"] <- "DurationGT15"
> vertical$No..of.Years.in.Uni.at.Time.of.Grant[vertical$No..of.Years.in.Uni.at.Time.of.Grant == "Less than 0"] <- "DurationLT0"
> vertical$No..of.Years.in.Uni.at.Time.of.Grant <- factor(vertical$No..of.Years.in.Uni.at.Time.of.Grant)
> 
> 
> ######################################################################
> ## A function to shorten the role titles
> 
> shortNames <- function(x, pre = ""){
+     x <- gsub("EXT_CHIEF_INVESTIGATOR",  "ECI", x)
+     x <- gsub("STUD_CHIEF_INVESTIGATOR", "SCI", x)
+     x <- gsub("CHIEF_INVESTIGATOR",      "CI", x)
+     x <- gsub("DELEGATED_RESEARCHER",    "DR", x)
+     x <- gsub("EXTERNAL_ADVISOR",        "EA", x)
+     x <- gsub("HONVISIT",                "HV", x)
+     x <- gsub("PRINCIPAL_SUPERVISOR",    "PS", x)
+     x <- gsub("STUDRES",                 "SR", x)
+     x <- gsub("Unk",                     "UNK", x)
+     other <- x[x != "Grant.Application.ID"]
+     c("Grant.Application.ID", paste(pre, other, sep = ""))
+   }
> 
> ## A function to find and remove zero-variance ("ZV") predictors
> noZV <- function(x) {
+     keepers <- unlist(lapply(x, function(x) length(unique(x)) > 1))
+     x[,keepers,drop = FALSE]
+   }
> 
> 
> ######################################################################
> ## Calculate the total number of people identified on the grant
> 
> people <- ddply(vertical, .(Grant.Application.ID), function(x) c(numPeople = nrow(x)))
> 
> ######################################################################
> ## Calculate the number of people per role
> 
> investCount <- ddply(vertical, .(Grant.Application.ID),
+                      function(x) as.data.frame(t(as.matrix(table(x$Role)))),
+                      .parallel = cores > 1)
> 
> ## Clean up the names
> names(investCount) <- shortNames(names(investCount), "Num")
> 
> ######################################################################
> ## For each role, calculate the frequency of people in each age group
> 
> investDOB <- ddply(vertical, .(Grant.Application.ID),
+                    function(x) {
+                      tabDF <- as.data.frame(table(x$Role, x$Year.of.Birth))
+                      out <- data.frame(t(tabDF$Freq))
+                      names(out) <- paste(tabDF$Var1, tabDF$Var2, sep = ".")
+                      out
+                    },
+                    .parallel = cores > 1)
> names(investDOB) <- shortNames(names(investDOB))
> investDOB <- noZV(investDOB)
> 
> ######################################################################
> ## For each role, calculate the frequency of people from each country
> 
> investCountry <- ddply(vertical, .(Grant.Application.ID),
+                        function(x) {
+                          tabDF <- as.data.frame(table(x$Role, x$Country.of.Birth))
+                          out <- data.frame(t(tabDF$Freq))
+                          names(out) <- paste(tabDF$Var1, tabDF$Var2, sep = ".")
+                          out
+                        },
+                        .parallel = cores > 1)
> names(investCountry) <- shortNames(names(investCountry))
> investCountry <- noZV(investCountry)
> 
> ######################################################################
> ## For each role, calculate the frequency of people for each language
> 
> investLang <- ddply(vertical, .(Grant.Application.ID),
+                     function(x) {
+                       tabDF <- as.data.frame(table(x$Role, x$Home.Language))
+                       out <- data.frame(t(tabDF$Freq))
+                       names(out) <- paste(tabDF$Var1, tabDF$Var2, sep = ".")
+                       out
+                     },
+                     .parallel = cores > 1)
> names(investLang) <- shortNames(names(investLang))
> investLang <- noZV(investLang)
> 
> ######################################################################
> ## For each role, determine who as a Ph.D.
> 
> investPhD <- ddply(vertical, .(Grant.Application.ID),
+                    function(x) {
+                      tabDF <- as.data.frame(table(x$Role, x$With.PHD))
+                      out <- data.frame(t(tabDF$Freq))
+                      names(out) <- paste(tabDF$Var1, tabDF$Var2, sep = ".")
+                      out
+                    },
+                    .parallel = cores > 1)
> investPhD <- investPhD[,-grep("\\.$", names(investPhD))]
> names(investPhD) <- shortNames(names(investPhD))
> names(investPhD) <- gsub("Yes ", "PhD", names(investPhD))
> investPhD <- noZV(investPhD)
> 
> ######################################################################
> ## For each role, calculate the number of successful and unsuccessful
> ## grants
> 
> investGrants <- ddply(vertical, .(Grant.Application.ID, Role),
+                       function(x) {
+                         data.frame(Success = sum(x$Number.of.Successful.Grant, na.rm = TRUE),
+                                    Unsuccess = sum(x$Number.of.Unsuccessful.Grant, na.rm = TRUE))
+ 
+                       },
+                       .parallel = cores > 1)
> investGrants <- reshape(investGrants, direction = "wide", idvar = "Grant.Application.ID", timevar = "Role")
> investGrants[is.na(investGrants)] <- 0
> 
> names(investGrants) <- shortNames(names(investGrants))
> investGrants <- noZV(investGrants)
> 
> ######################################################################
> ## Create variables for each role/department combination
> 
> investDept <- ddply(vertical, .(Grant.Application.ID),
+                     function(x) {
+                       tabDF <- as.data.frame(table(x$Role, x$Dept.No.))
+                       out <- data.frame(t(tabDF$Freq))
+                       names(out) <- paste(tabDF$Var1, tabDF$Var2, sep = ".")
+                       out
+                     },
+                     .parallel = cores > 1)
> names(investDept) <- shortNames(names(investDept))
> investDept <- noZV(investDept)
> 
> ######################################################################
> ## Create variables for each role/faculty #
> 
> 
> investFaculty <- ddply(vertical, .(Grant.Application.ID),
+                        function(x) {
+                          tabDF <- as.data.frame(table(x$Role, x$Faculty.No.))
+                          out <- data.frame(t(tabDF$Freq))
+                          names(out) <- paste(tabDF$Var1, tabDF$Var2, sep = ".")
+                          out
+                        },
+                        .parallel = cores > 1)
> names(investFaculty) <- shortNames(names(investFaculty))
> investFaculty <- noZV(investFaculty)
> 
> ######################################################################
> ## Create dummy variables for each tenure length
> 
> investDuration <- ddply(vertical, .(Grant.Application.ID),
+                      function(x) as.data.frame(t(as.matrix(table(x$No..of.Years.in.Uni.at.Time.of.Grant)))),
+                      .parallel = cores > 1)
> investDuration[is.na(investDuration)] <- 0
> 
> 
> ######################################################################
> ## Create variables for the number of publications per journal
> ## type. Note that we also compute the total number, which should be
> ## removed for models that cannot deal with such a linear dependency
> 
> totalPub <- ddply(vertical, .(Grant.Application.ID),
+                    function(x) {
+                      data.frame(AstarTotal = sum(x$A., na.rm = TRUE),
+                                 ATotal = sum(x$A, na.rm = TRUE),
+                                 BTotal = sum(x$B, na.rm = TRUE),
+                                 CTotal = sum(x$C, na.rm = TRUE),
+                                 allPub = sum(c(x$A., x$A, x$B, x$C), na.rm = TRUE))
+ 
+                    },
+                    .parallel = cores > 1)
> 
> ######################################################################
> ## Create variables for the number of publications per journal
> ## type per role.
> 
> investPub <- ddply(vertical, .(Grant.Application.ID, Role),
+                    function(x) {
+                      data.frame(Astar = sum(x$A., na.rm = TRUE),
+                                 A = sum(x$A, na.rm = TRUE),
+                                 B = sum(x$B, na.rm = TRUE),
+                                 C = sum(x$C, na.rm = TRUE))
+ 
+                    },
+                    .parallel = cores > 1)
> investPub <- reshape(investPub, direction = "wide", idvar = "Grant.Application.ID", timevar = "Role")
> investPub[is.na(investPub)] <- 0
> 
> names(investPub) <- shortNames(names(investPub))
> investPub <- noZV(investPub)
> 
> ######################################################################
> ## Create variables for each RFCD code
> 
> RFCDcount <- ddply(vertical, .(Grant.Application.ID),
+                      function(x) as.data.frame(t(as.matrix(table(x$RFCD.Code)))),
+                      .parallel = cores > 1)
> RFCDcount <- noZV(RFCDcount)
> 
> ######################################################################
> ## Create variables for each SEO code
> 
> SEOcount <- ddply(vertical, .(Grant.Application.ID),
+                      function(x) as.data.frame(t(as.matrix(table(x$SEO.Code)))),
+                      .parallel = cores > 1)
> SEOcount <- noZV(SEOcount)
> 
> ######################################################################
> ### Make dummy vars out of grant-specific data
> 
> grantData <- raw[, c("Sponsor.Code", "Contract.Value.Band...see.note.A", "Grant.Category.Code")]
> 
> ## Make a lubridate object for the time, then derive the day, week and month info
> startTime <- dmy(raw$Start.date)
> 
> grantData$Month <- factor(as.character(month(startTime, label = TRUE)))
> grantData$Weekday <- factor(as.character(wday(startTime, label = TRUE)))
> grantData$Day <- day(startTime)
> grantYear <- year(startTime)
> 
> ######################################################################
> ### Use the dummyVars function to create binary variables for
> ### grant-specific variables
> 
> dummies <- dummyVars(~., data = grantData, levelsOnly = TRUE)
> grantData <- as.data.frame(predict(dummies, grantData))
> names(grantData) <- gsub(" ", "", names(grantData))
> 
> grantData$Grant.Application.ID <- raw$Grant.Application.ID
> grantData$Class <- factor(ifelse(raw$Grant.Status, "successful", "unsuccessful"))
> grantData$Grant.Application.ID <- raw$Grant.Application.ID
> 
> grantData$is2008 <- year(startTime) == 2008
> grantData <- noZV(grantData)
> 
> ######################################################################
> ### Merge all the predictors together, remove zero variance columns
> ### and merge in the outcome data
> summarized <- merge(investCount, investDOB)
> summarized <- merge(summarized, investCountry)
> summarized <- merge(summarized, investLang)
> summarized <- merge(summarized, investPhD)
> summarized <- merge(summarized, investGrants)
> summarized <- merge(summarized, investDept)
> summarized <- merge(summarized, investFaculty)
> summarized <- merge(summarized, investDuration)
> summarized <- merge(summarized, investPub)
> summarized <- merge(summarized, totalPub)
> summarized <- merge(summarized, people)
> summarized <- merge(summarized, RFCDcount)
> summarized <- merge(summarized, SEOcount)
> 
> summarized <- merge(summarized, grantData)
> ## Remove the ID column
> summarized$Grant.Application.ID <- NULL
> print(str(summarized))
'data.frame':	8708 obs. of  1911 variables:
 $ NumCI                 : int  1 1 3 1 1 1 3 2 2 1 ...
 $ NumDR                 : int  0 0 1 0 0 0 0 0 0 0 ...
 $ NumECI                : int  0 0 3 3 0 0 1 1 2 3 ...
 $ NumEA                 : int  0 0 0 0 0 0 0 0 0 0 ...
 $ NumHV                 : int  0 0 0 0 0 0 0 0 0 0 ...
 $ NumPS                 : int  0 0 0 1 0 0 0 0 0 0 ...
 $ NumSCI                : int  0 0 0 1 0 0 0 0 0 0 ...
 $ NumSR                 : int  0 0 0 0 0 0 0 0 0 0 ...
 $ NumUNK                : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1900               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1925               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1930               : int  0 0 0 0 0 0 0 0 0 1 ...
 $ CI.1935               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1940               : int  0 0 0 0 0 0 0 1 0 0 ...
 $ DR.1940               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1945               : int  0 0 0 0 0 0 0 0 1 0 ...
 $ DR.1945               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.1945              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1945               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1950               : int  0 0 2 0 0 1 1 0 1 0 ...
 $ DR.1950               : int  0 0 1 0 0 0 0 0 0 0 ...
 $ ECI.1950              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1950               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1950               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1955               : int  0 0 1 0 0 0 0 0 0 0 ...
 $ DR.1955               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.1955              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1955               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1955               : int  0 0 0 1 0 0 0 0 0 0 ...
 $ CI.1960               : int  0 1 0 0 0 0 2 0 0 0 ...
 $ DR.1960               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.1960              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1960               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1960               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1965               : int  1 0 0 0 1 0 0 1 0 0 ...
 $ DR.1965               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.1965              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1965               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1965               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1970               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ DR.1970               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.1970              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1970               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1970               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1975               : int  0 0 0 1 0 0 0 0 0 0 ...
 $ DR.1975               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.1975              : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1975               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1975               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ SR.1975               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1980               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ DR.1980               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.1980               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.1985               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.1985               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.AsiaPacific        : int  1 0 1 0 0 0 0 0 0 0 ...
 $ DR.AsiaPacific        : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.AsiaPacific        : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.Australia          : int  0 1 2 1 0 1 2 2 2 0 ...
 $ DR.Australia          : int  0 0 1 0 0 0 0 0 0 0 ...
 $ ECI.Australia         : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.Australia          : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.Australia          : int  0 0 0 1 0 0 0 0 0 0 ...
 $ CI.EasternEurope      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.GreatBritain       : int  0 0 0 0 0 0 1 0 0 0 ...
 $ DR.GreatBritain       : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.GreatBritain      : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.GreatBritain       : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.MiddleEastandAfrica: int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.NewZealand         : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.NewZealand         : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.NorthAmerica       : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.SouthAfrica        : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.SouthAfrica        : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.TheAmericas        : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.TheAmericas        : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.WesternEurope      : int  0 0 0 0 1 0 0 0 0 0 ...
 $ ECI.WesternEurope     : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.English            : int  0 0 0 0 0 0 0 0 2 0 ...
 $ DR.English            : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.English           : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.English            : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.OtherLang          : int  1 0 0 0 0 0 0 0 0 0 ...
 $ DR.OtherLang          : int  0 0 0 0 0 0 0 0 0 0 ...
 $ CI.PhD                : int  0 1 2 1 1 1 2 0 2 0 ...
 $ DR.PhD                : int  0 0 0 0 0 0 0 0 0 0 ...
 $ ECI.PhD               : int  0 0 0 0 0 0 0 0 0 0 ...
 $ HV.PhD                : int  0 0 0 0 0 0 0 0 0 0 ...
 $ PS.PhD                : int  0 0 0 1 0 0 0 0 0 0 ...
 $ SR.PhD                : int  0 0 0 0 0 0 0 0 0 0 ...
 $ Success.CI            : num  0 0 0 0 0 2 0 0 2 0 ...
 $ Unsuccess.CI          : num  0 0 0 0 0 0 1 3 1 0 ...
 $ Success.DR            : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Unsuccess.DR          : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Success.ECI           : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Unsuccess.ECI         : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Success.PS            : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Unsuccess.PS          : num  0 0 0 0 0 0 0 0 0 0 ...
 $ Success.HV            : num  0 0 0 0 0 0 0 0 0 0 ...
  [list output truncated]
NULL
> 
> ######################################################################
> ### We'll split all of the pre-2008 data into the training set and a
> ### portion of the 2008 data too
> 
> training <- subset(summarized, !is2008)
> pre2008 <- 1:nrow(training)
> year2008 <- subset(summarized, is2008)
> 
> ## Now randomly select some 2008 data for model training and add it
> ## back into the existing training data
> set.seed(568)
> inTrain <- createDataPartition(year2008$Class, p = 3/4)[[1]]
> training2 <- year2008[ inTrain,]
> testing   <- year2008[-inTrain,]
> training <- rbind(training, training2)
> 
> training$is2008 <- testing$is2008 <- NULL
> 
> training <- noZV(training)
> testing <- testing[, names(training)]
> 
> ######################################################################
> ### Create two character vectors for different predictor sets. One
> ### will have all the predictors (called 'fullSet').
> ##
> ### Another has some of the sparse predictors removed for models that
> ### require such filtering. This will be called 'reducedSet'
> ### (predictors without sparse or Near Zero Variance predictors). This
> ### set will also have predictors removed that are almost completely
> ### correlated with other predictors
> 
> fullSet <- names(training)[names(training) != "Class"]
> 
> ###################################################################
> ### In the classification tree chapter, there is a different set
> ### of predictors that use factor encodings of some of the 
> ### predictors
> 
> factorPredictors <- names(training)[names(training) != "Class"]
> factorPredictors <- factorPredictors[!grepl("Sponsor[0-9]", factorPredictors)]
> factorPredictors <- factorPredictors[!grepl("SponsorUnk", factorPredictors)]
> factorPredictors <- factorPredictors[!grepl("ContractValueBand[A-Z]", factorPredictors)]
> factorPredictors <- factorPredictors[!grepl("GrantCat", factorPredictors)]
> factorPredictors <- factorPredictors[!(factorPredictors %in% levels(training$Month))]
> factorPredictors <- factorPredictors[!(factorPredictors %in% levels(training$Weekday))]
> 
> factorForm <- paste("Class ~ ", paste(factorPredictors, collapse = "+"))
> factorForm <- as.formula(factorForm)
> 
> ### Some are extremely correlated, so remove
> predCorr <- cor(training[,fullSet])
> highCorr <- findCorrelation(predCorr, .99)
> fullSet <- fullSet[-highCorr]
> 
> isNZV <- nearZeroVar(training[,fullSet], saveMetrics = TRUE, freqCut = floor(nrow(training)/5))
> fullSet <-  rownames(subset(isNZV, !nzv))
> str(fullSet)
 chr [1:1073] "NumCI" "NumDR" "NumECI" "NumEA" "NumHV" "NumPS" ...
> 
> reducedSet <- rownames(subset(isNZV, !nzv & freqRatio < floor(nrow(training)/50)))
> 
> ### Perfectly collinear predictors (due to their construction) March
> ### and Sunday were selected because they have the lowest frequency of
> ### all months and days
> reducedSet <- reducedSet[(reducedSet != "allPub") &
+                          (reducedSet != "numPeople") &
+                          (reducedSet != "Mar") &
+                          (reducedSet != "Sun")
+                          ]
> 
> ### all months and days
> reducedSet <- reducedSet[(reducedSet != "allPub") &
+                          (reducedSet != "numPeople") &
+                          (reducedSet != "Mar") &
+                          (reducedSet != "Sun")
+                          ]
> str(reducedSet)
 chr [1:252] "NumCI" "NumDR" "NumECI" "NumPS" "NumSCI" "NumSR" ...
> 
> sessionInfo()
R Under development (unstable) (2014-06-02 r65832)
Platform: x86_64-apple-darwin10.8.0 (64-bit)

locale:
[1] en_US.US-ASCII/en_US.US-ASCII/en_US.US-ASCII/C/en_US.US-ASCII/en_US.US-ASCII

attached base packages:
[1] parallel  stats     graphics  grDevices utils     datasets  methods  
[8] base     

other attached packages:
[1] doMC_1.3.3      iterators_1.0.7 foreach_1.4.2   lubridate_1.3.3
[5] caret_6.0-30    ggplot2_0.9.3.1 lattice_0.20-29 plyr_1.8.1     

loaded via a namespace (and not attached):
 [1] BradleyTerry2_1.0-5 brglm_0.5-9         car_2.0-19         
 [4] codetools_0.2-8     colorspace_1.2-4    compiler_3.2.0     
 [7] dichromat_2.0-0     digest_0.6.4        grid_3.2.0         
[10] gtable_0.1.2        gtools_3.4.1        labeling_0.2       
[13] lme4_1.1-6          MASS_7.3-33         Matrix_1.1-3       
[16] memoise_0.2.1       minqa_1.2.3         munsell_0.4.2      
[19] nlme_3.1-117        nnet_7.3-8          proto_0.3-10       
[22] RColorBrewer_1.0-5  Rcpp_0.11.1         RcppEigen_0.3.2.1.2
[25] reshape2_1.4        scales_0.2.3        splines_3.2.0      
[28] stringr_0.6.2      
> 
> 
> proc.time()
   user  system elapsed 
859.647  20.988 760.090 
