
R version 3.0.1 (2013-05-16) -- "Good Sport"
Copyright (C) 2013 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) 
> ###
> ### Chapter 11: Measuring Performance in Classification Models
> ###
> ### Required packages: AppliedPredictiveModeling, caret, MASS, randomForest,
> ###                    pROC, klaR
> ###
> ### Data used: The solubility from the AppliedPredictiveModeling package
> ###
> ### 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.
> ###
> ################################################################################
> 
> ################################################################################
> ### Section 11.1 Class Predictions
> 
> library(AppliedPredictiveModeling)
> 
> ### Simulate some two class data with two predictors
> set.seed(975)
> training <- quadBoundaryFunc(500)
> testing <- quadBoundaryFunc(1000)
> testing$class2 <- ifelse(testing$class == "Class1", 1, 0)
> testing$ID <- 1:nrow(testing)
> 
> ### Fit models
> library(MASS)
> qdaFit <- qda(class ~ X1 + X2, data = training)
> library(randomForest)
randomForest 4.6-7
Type rfNews() to see new features/changes/bug fixes.
> rfFit <- randomForest(class ~ X1 + X2, data = training, ntree = 2000)
> 
> ### Predict the test set
> testing$qda <- predict(qdaFit, testing)$posterior[,1]
> testing$rf <- predict(rfFit, testing, type = "prob")[,1]
> 
> 
> ### Generate the calibration analysis
> library(caret)
Loading required package: lattice
Loading required package: ggplot2
> calData1 <- calibration(class ~ qda + rf, data = testing, cuts = 10)
> 
> ### Plot the curve
> xyplot(calData1, auto.key = list(columns = 2))
> 
> ### To calibrate the data, treat the probabilities as inputs into the
> ### model
> 
> trainProbs <- training
> trainProbs$qda <- predict(qdaFit)$posterior[,1]
> 
> ### These models take the probabilities as inputs and, based on the
> ### true class, re-calibrate them.
> library(klaR)
> nbCal <- NaiveBayes(class ~ qda, data = trainProbs, usekernel = TRUE)
> 
> ### We use relevel() here because glm() models the probability of the
> ### second factor level.
> lrCal <- glm(relevel(class, "Class2") ~ qda, data = trainProbs, family = binomial)
> 
> ### Now re-predict the test set using the modified class probability
> ### estimates
> testing$qda2 <- predict(nbCal, testing[, "qda", drop = FALSE])$posterior[,1]
> testing$qda3 <- predict(lrCal, testing[, "qda", drop = FALSE], type = "response")
> 
> 
> ### Manipulate the data a bit for pretty plotting
> simulatedProbs <- testing[, c("class", "rf", "qda3")]
> names(simulatedProbs) <- c("TrueClass", "RandomForestProb", "QDACalibrated")
> simulatedProbs$RandomForestClass <-  predict(rfFit, testing)
> 
> calData2 <- calibration(class ~ qda + qda2 + qda3, data = testing)
> calData2$data$calibModelVar <- as.character(calData2$data$calibModelVar)
> calData2$data$calibModelVar <- ifelse(calData2$data$calibModelVar == "qda", 
+                                       "QDA",
+                                       calData2$data$calibModelVar)
> calData2$data$calibModelVar <- ifelse(calData2$data$calibModelVar == "qda2", 
+                                       "Bayesian Calibration",
+                                       calData2$data$calibModelVar)
> 
> calData2$data$calibModelVar <- ifelse(calData2$data$calibModelVar == "qda3", 
+                                       "Sigmoidal Calibration",
+                                       calData2$data$calibModelVar)
> 
> calData2$data$calibModelVar <- factor(calData2$data$calibModelVar,
+                                       levels = c("QDA", 
+                                                  "Bayesian Calibration", 
+                                                  "Sigmoidal Calibration"))
> 
> xyplot(calData2, auto.key = list(columns = 1))
> 
> ### Recreate the model used in the over-fitting chapter
> 
> library(caret)
> data(GermanCredit)
> 
> ## First, remove near-zero variance predictors then get rid of a few predictors 
> ## that duplicate values. For example, there are two possible values for the 
> ## housing variable: "Rent", "Own" and "ForFree". So that we don't have linear
> ## dependencies, we get rid of one of the levels (e.g. "ForFree")
> 
> GermanCredit <- GermanCredit[, -nearZeroVar(GermanCredit)]
> GermanCredit$CheckingAccountStatus.lt.0 <- NULL
> GermanCredit$SavingsAccountBonds.lt.100 <- NULL
> GermanCredit$EmploymentDuration.lt.1 <- NULL
> GermanCredit$EmploymentDuration.Unemployed <- NULL
> GermanCredit$Personal.Male.Married.Widowed <- NULL
> GermanCredit$Property.Unknown <- NULL
> GermanCredit$Housing.ForFree <- NULL
> 
> ## Split the data into training (80%) and test sets (20%)
> set.seed(100)
> inTrain <- createDataPartition(GermanCredit$Class, p = .8)[[1]]
> GermanCreditTrain <- GermanCredit[ inTrain, ]
> GermanCreditTest  <- GermanCredit[-inTrain, ]
> 
> set.seed(1056)
> logisticReg <- train(Class ~ .,
+                      data = GermanCreditTrain,
+                      method = "glm",
+                      trControl = trainControl(method = "repeatedcv", 
+                                               repeats = 5))
Loading required package: class
> logisticReg
Generalized Linear Model 

800 samples
 41 predictors
  2 classes: 'Bad', 'Good' 

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 5 times) 

Summary of sample sizes: 720, 720, 720, 720, 720, 720, ... 

Resampling results

  Accuracy  Kappa  Accuracy SD  Kappa SD
  0.749     0.365  0.0516       0.122   

 
> 
> ### Predict the test set
> creditResults <- data.frame(obs = GermanCreditTest$Class)
> creditResults$prob <- predict(logisticReg, GermanCreditTest, type = "prob")[, "Bad"]
> creditResults$pred <- predict(logisticReg, GermanCreditTest)
> creditResults$Label <- ifelse(creditResults$obs == "Bad", 
+                               "True Outcome: Bad Credit", 
+                               "True Outcome: Good Credit")
> 
> ### Plot the probability of bad credit
> histogram(~prob|Label,
+           data = creditResults,
+           layout = c(2, 1),
+           nint = 20,
+           xlab = "Probability of Bad Credit",
+           type = "count")
> 
> ### Calculate and plot the calibration curve
> creditCalib <- calibration(obs ~ prob, data = creditResults)
> xyplot(creditCalib)
> 
> ### Create the confusion matrix from the test set.
> confusionMatrix(data = creditResults$pred, 
+                 reference = creditResults$obs)
Confusion Matrix and Statistics

          Reference
Prediction Bad Good
      Bad   24   10
      Good  36  130
                                          
               Accuracy : 0.77            
                 95% CI : (0.7054, 0.8264)
    No Information Rate : 0.7             
    P-Value [Acc > NIR] : 0.0168694       
                                          
                  Kappa : 0.375           
 Mcnemar's Test P-Value : 0.0002278       
                                          
            Sensitivity : 0.4000          
            Specificity : 0.9286          
         Pos Pred Value : 0.7059          
         Neg Pred Value : 0.7831          
             Prevalence : 0.3000          
         Detection Rate : 0.1200          
   Detection Prevalence : 0.1700          
      Balanced Accuracy : 0.6643          
                                          
       'Positive' Class : Bad             
                                          
> 
> ### ROC curves:
> 
> ### Like glm(), roc() treats the last level of the factor as the event
> ### of interest so we use relevel() to change the observed class data
> 
> library(pROC)
Loading required package: plyr
Type 'citation("pROC")' for a citation.

Attaching package: ‘pROC’

The following object is masked from ‘package:stats’:

    cov, smooth, var

> creditROC <- roc(relevel(creditResults$obs, "Good"), creditResults$prob)
> 
> coords(creditROC, "all")[,1:3]
             all         all         all
threshold   -Inf 0.006199758 0.009708574
specificity    0 0.007142857 0.014285714
sensitivity    1 1.000000000 1.000000000
> 
> auc(creditROC)
Area under the curve: 0.775
> ci.auc(creditROC)
95% CI: 0.7032-0.8468 (DeLong)
> 
> ### Note the x-axis is reversed
> plot(creditROC)

Call:
roc.default(response = relevel(creditResults$obs, "Good"), predictor = creditResults$prob)

Data: creditResults$prob in 140 controls (relevel(creditResults$obs, "Good") Good) < 60 cases (relevel(creditResults$obs, "Good") Bad).
Area under the curve: 0.775
> 
> ### Old-school:
> plot(creditROC, legacy.axes = TRUE)

Call:
roc.default(response = relevel(creditResults$obs, "Good"), predictor = creditResults$prob)

Data: creditResults$prob in 140 controls (relevel(creditResults$obs, "Good") Good) < 60 cases (relevel(creditResults$obs, "Good") Bad).
Area under the curve: 0.775
> 
> ### Lift charts
> 
> creditLift <- lift(obs ~ prob, data = creditResults)
> xyplot(creditLift)
> 
> 
> ################################################################################
> ### Session Information
> 
> sessionInfo()
R version 3.0.1 (2013-05-16)
Platform: x86_64-apple-darwin10.8.0 (64-bit)

locale:
[1] en_US.UTF-8/en_US.UTF-8/en_US.UTF-8/C/en_US.UTF-8/en_US.UTF-8

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

other attached packages:
 [1] pROC_1.5.4                      plyr_1.8                       
 [3] e1071_1.6-1                     class_7.3-7                    
 [5] klaR_0.6-7                      caret_6.0-22                   
 [7] ggplot2_0.9.3.1                 lattice_0.20-15                
 [9] randomForest_4.6-7              MASS_7.3-26                    
[11] AppliedPredictiveModeling_1.1-5

loaded via a namespace (and not attached):
 [1] car_2.0-16         codetools_0.2-8    colorspace_1.2-1   compiler_3.0.1    
 [5] CORElearn_0.9.41   dichromat_2.0-0    digest_0.6.3       foreach_1.4.0     
 [9] grid_3.0.1         gtable_0.1.2       iterators_1.0.6    labeling_0.1      
[13] munsell_0.4        proto_0.3-10       RColorBrewer_1.0-5 reshape2_1.2.2    
[17] scales_0.2.3       stringr_0.6.2      tools_3.0.1       
> 
> q("no")
> proc.time()
   user  system elapsed 
 11.120   0.526  11.698 
