library(glmnet)
library(varSelRF)
library(plot3D)
library(FSelector)
library(mlbench)
library(knitr)
library(rgl)
library(R.basic)
set.seed(123)

We chose to have 3 categories.
A Gain in rank -> Black – Improves rank
No Change in rank -> Red
A Loss in rank -> Green – Falls behind
Load the data

dat <- read.csv("C:/Users/Prashan/Dropbox (MIT)/MIT/Predictive Analytics/code/data/NASCAR_5f/allf_3c_phoenix2_2014_prototype_sel.csv")

Start with 43 features

features <- 3:45 
complete <- which(rowSums(is.na(dat[, features]))==0)

datc <- dat[complete, ]
x <- as.matrix(datc[, features])
y <- datc[,2]
cl <- factor(y)

nascar_data_with_label=datc[,(-1)]
selected_features<-c()

Variable selection from random forests using OOB error

knit_hooks$set(webgl = hook_webgl)
rf.vs1 <- varSelRF(x, cl, ntree = 200, ntreeIterat = 100,
vars.drop.frac = 0.2)
rf.vs1$selected.vars
## [1] "X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"
## [2] "X34..before.pit..25th.percentile.rank.upto.bef.pit"
#   if (length(rf.vs1$selected.vars)==3){
#         plot3d(x[,rf.vs1$selected.vars[1]],x[,rf.vs1$selected.vars[2]],x[,rf.vs1$selected.vars[3]],col=y,xlab=rf.vs1$selected.vars[1],ylab=rf.vs1$selected.vars[2],zlab=rf.vs1$selected.vars[3])
#   }else if (length(rf.vs1$selected.vars)==2){
#         plot(x[,rf.vs1$selected.vars[1]],x[,rf.vs1$selected.vars[2]],col=y,xlab=rf.vs1$selected.vars[1],ylab=rf.vs1$selected.vars[2])
  # }
# plot(rf.vs1)

Variable selection from CFS filter (https://cran.r-project.org/web/packages/FSelector/FSelector.pdf)

knit_hooks$set(webgl = hook_webgl)
subset <- cfs(rank_change_label~., datc[,(-1)])
plot3d(x[,subset[1]],x[,subset[2]],x[,subset[3]],col=y,xlab=rf.vs1$selected.vars[1],ylab=rf.vs1$selected.vars[2],zlab=rf.vs1$selected.vars[3])

subset
## [1] "X76..after.pit..indicator.2.tire.change..ref.19"                                                       
## [2] "X86..before.pit..indicator.front..lte.8..of.the.pack.pre.pit"                                          
## [3] "X89..before.pit..Indicator.2.tire.AND.bottom..gte.23..of.pack.at.pit.entry...features.76...feature.87."
## [4] "X140..after.pit..Time.in.pits.before.outing"                                                           
## [5] "X160..before.pit..sqrt.of.Binned.avg.prev.slope.HI.RES.133"

Variable selection from Consistency-based filter (https://cran.r-project.org/web/packages/FSelector/FSelector.pdf)

knit_hooks$set(webgl = hook_webgl)
subset <- consistency(rank_change_label~., datc[,(-1)])
plot3d(x[,subset[1]],x[,subset[2]],x[,subset[3]],col=y,xlab=subset[1],ylab=subset[2],zlab=subset[4])
## Warning in persp.default(x = xdummy, y = ydummy, z = zdummy, xlim = xlim, :
## surface extends beyond the box

subset
## [1] "X26..before.pit..incoming.rank.before.pit.bef.leg" 
## [2] "X34..before.pit..25th.percentile.rank.upto.bef.pit"
## [3] "X35..before.pit..75th.percentile.rank.upto.bef.pit"
## [4] "X82..before.pit..starting.position.of.the.car"
selected_features<-c(selected_features,subset)

Variable selection from RReliefF filter (https://cran.r-project.org/web/packages/FSelector/FSelector.pdf)

knit_hooks$set(webgl = hook_webgl)
weights <- relief(rank_change_label~., datc[,(-1)], neighbours.count = 5, sample.size = 20)
subset <- cutoff.k(weights,5)
plot3d(x[,subset[1]],x[,subset[2]],x[,subset[3]],col=y,xlab=subset[1],ylab=subset[2],zlab=subset[3])

subset
## [1] "X77..after.pit..indicator.4.tire.change..ref.19"                        
## [2] "X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood"
## [3] "X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood."        
## [4] "X140..after.pit..Time.in.pits.before.outing"                            
## [5] "X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood"
selected_features<-c(selected_features,subset)
#RandomForest filter
#1=mean decrease in accuracy, 2=mean decrease in node impurity
# weights <- random.forest.importance(rank_change_label~., datc[,(-1)], importance.type = 2)
# subset <- cutoff.biggest.diff(weights)
# subset

Variable selection from Information Gain (https://cran.r-project.org/web/packages/FSelector/FSelector.pdf)

knit_hooks$set(webgl = hook_webgl)
weights <- information.gain(rank_change_label~., nascar_data_with_label)
subset <- cutoff.biggest.diff(weights)
plot3d(x[,subset[1]],x[,subset[2]],x[,subset[3]],col=y,xlab=subset[1],ylab=subset[2],zlab=subset[3])
## Warning in persp.default(x = xdummy, y = ydummy, z = zdummy, xlim = xlim, :
## surface extends beyond the box

subset
##  [1] "X26..before.pit..incoming.rank.before.pit.bef.leg"                                  
##  [2] "X82..before.pit..starting.position.of.the.car"                                      
##  [3] "X34..before.pit..25th.percentile.rank.upto.bef.pit"                                 
##  [4] "X35..before.pit..75th.percentile.rank.upto.bef.pit"                                 
##  [5] "X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES"              
##  [6] "X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127"         
##  [7] "X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127"       
##  [8] "X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"  
##  [9] "X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"
## [10] "X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"
selected_features<-c(selected_features,subset)
unique_f<-unique(selected_features)
unique_f
##  [1] "X26..before.pit..incoming.rank.before.pit.bef.leg"                                  
##  [2] "X34..before.pit..25th.percentile.rank.upto.bef.pit"                                 
##  [3] "X35..before.pit..75th.percentile.rank.upto.bef.pit"                                 
##  [4] "X82..before.pit..starting.position.of.the.car"                                      
##  [5] "X77..after.pit..indicator.4.tire.change..ref.19"                                    
##  [6] "X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood"            
##  [7] "X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood."                    
##  [8] "X140..after.pit..Time.in.pits.before.outing"                                        
##  [9] "X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood"            
## [10] "X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES"              
## [11] "X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127"         
## [12] "X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127"       
## [13] "X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"  
## [14] "X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"
## [15] "X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137"
subset_x=x[,unique_f]

lasso with a multinomial loss. Here we train on the full set of features and see that even with maxit=1000000 there is no convergence.

train <- sample(nrow(x[]), round(nrow(x) * 0.7))
cvfit <- cv.glmnet(x[train, ], y[train], family="multinomial",maxit=1000000)
## Warning: from glmnet Fortran code (error code -72); Convergence for 72th
## lambda value not reached after maxit=1000000 iterations; solutions for
## larger lambdas returned
## Warning: from glmnet Fortran code (error code -76); Convergence for 76th
## lambda value not reached after maxit=1000000 iterations; solutions for
## larger lambdas returned
## Warning: from glmnet Fortran code (error code -91); Convergence for 91th
## lambda value not reached after maxit=1000000 iterations; solutions for
## larger lambdas returned
## Warning: from glmnet Fortran code (error code -79); Convergence for 79th
## lambda value not reached after maxit=1000000 iterations; solutions for
## larger lambdas returned
## Warning: from glmnet Fortran code (error code -77); Convergence for 77th
## lambda value not reached after maxit=1000000 iterations; solutions for
## larger lambdas returned
plot(cvfit) # let's look at the cross validated error to choose lambda

We train on the data with a subset of features

train <- sample(nrow(subset_x), round(nrow(subset_x) * 0.7))
cvfit <- cv.glmnet(subset_x[train, ], y[train], family="multinomial",maxit=1000000)
plot(cvfit) # let's look at the cross validated error to choose lambda

coef(cvfit, s="lambda.1se")
## $`1`
## 16 x 1 sparse Matrix of class "dgCMatrix"
##                                                                                             1
## (Intercept)                                                                         0.3115248
## X26..before.pit..incoming.rank.before.pit.bef.leg                                   .        
## X34..before.pit..25th.percentile.rank.upto.bef.pit                                  .        
## X35..before.pit..75th.percentile.rank.upto.bef.pit                                  .        
## X82..before.pit..starting.position.of.the.car                                       .        
## X77..after.pit..indicator.4.tire.change..ref.19                                     .        
## X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood             .        
## X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood.                     .        
## X140..after.pit..Time.in.pits.before.outing                                         .        
## X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood             .        
## X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES               .        
## X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127          .        
## X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127        .        
## X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137   .        
## X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137 .        
## X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137    .        
## 
## $`2`
## 16 x 1 sparse Matrix of class "dgCMatrix"
##                                                                                              1
## (Intercept)                                                                         -0.4448013
## X26..before.pit..incoming.rank.before.pit.bef.leg                                    .        
## X34..before.pit..25th.percentile.rank.upto.bef.pit                                   .        
## X35..before.pit..75th.percentile.rank.upto.bef.pit                                   .        
## X82..before.pit..starting.position.of.the.car                                        .        
## X77..after.pit..indicator.4.tire.change..ref.19                                      .        
## X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood              .        
## X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood.                      .        
## X140..after.pit..Time.in.pits.before.outing                                          .        
## X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood              .        
## X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES                .        
## X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127           .        
## X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127         .        
## X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137    .        
## X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137  .        
## X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137     .        
## 
## $`3`
## 16 x 1 sparse Matrix of class "dgCMatrix"
##                                                                                             1
## (Intercept)                                                                         0.1332765
## X26..before.pit..incoming.rank.before.pit.bef.leg                                   .        
## X34..before.pit..25th.percentile.rank.upto.bef.pit                                  .        
## X35..before.pit..75th.percentile.rank.upto.bef.pit                                  .        
## X82..before.pit..starting.position.of.the.car                                       .        
## X77..after.pit..indicator.4.tire.change..ref.19                                     .        
## X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood             .        
## X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood.                     .        
## X140..after.pit..Time.in.pits.before.outing                                         .        
## X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood             .        
## X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES               .        
## X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127          .        
## X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127        .        
## X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137   .        
## X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137 .        
## X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137    .
yhat <- predict(cvfit, newx=subset_x[-train, ], s="lambda.1se", type="class")
mean(y[-train] != yhat) # classification error
## [1] 0.375
table(y[-train], yhat) # confusion matrix
##    yhat
##      1
##   1 30
##   2  7
##   3 11

We look at the pairwise plots of the features selected by the various algorithms.

# pairs(x, pch="o", col=y, lower.panel=NULL)
pairs(subset_x, pch="o", col=y, lower.panel=NULL)

Using only the selected subset of unique features

pca <- prcomp(subset_x, scale=TRUE)
plot(pca$x, col=y, pch=20)

The first two principal component directions represent the following linear combinations of nutrients:

pca$rotation[,1:2]
##                                                                                             PC1
## X26..before.pit..incoming.rank.before.pit.bef.leg                                    0.32375470
## X34..before.pit..25th.percentile.rank.upto.bef.pit                                   0.32943558
## X35..before.pit..75th.percentile.rank.upto.bef.pit                                   0.32871785
## X82..before.pit..starting.position.of.the.car                                        0.31609669
## X77..after.pit..indicator.4.tire.change..ref.19                                      0.12114162
## X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood              0.10706984
## X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood.                      0.11230882
## X140..after.pit..Time.in.pits.before.outing                                          0.08815530
## X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood             -0.08889812
## X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES                0.33384930
## X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127           0.32024680
## X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127         0.30094928
## X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137    0.32826242
## X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137  0.32329384
## X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137     0.08600491
##                                                                                               PC2
## X26..before.pit..incoming.rank.before.pit.bef.leg                                   -0.0201284062
## X34..before.pit..25th.percentile.rank.upto.bef.pit                                  -0.0530322125
## X35..before.pit..75th.percentile.rank.upto.bef.pit                                  -0.0124555595
## X82..before.pit..starting.position.of.the.car                                       -0.0181138726
## X77..after.pit..indicator.4.tire.change..ref.19                                      0.5855772347
## X61..before.pit..NBHD.prev.epoch..number.of.4.pit.types.of.neighborhood             -0.4787802098
## X56..before.pit..NBHD.prev.epoch..median.ranks.of.neighborhood.                      0.0030155914
## X140..after.pit..Time.in.pits.before.outing                                          0.5744125430
## X60..before.pit..NBHD.prev.epoch..number.of.2.pit.types.of.neighborhood              0.2885625126
## X137..before.pit...Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES               -0.0151548930
## X157..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.127          -0.0076419610
## X158..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.127        -0.0009078096
## X163..before.pit..sqrt.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137   -0.0107298101
## X164..before.pit..square.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137 -0.0260680148
## X165..before.pit..exp.of..Binned.avg.pre.slope..prev.epoch.final.rank.HI.RES.137     0.0992836321