Best Subset Selection

Here we apply the best subset selection approach to the Hitters data. We wish to predict a baseball player’s Salary on the basis of various statistics associated with performance in the previous year.

First of all, we note that the Salary variable is missing for some of the players. The is.na() function can be used to identify the missing observations. It returns a vector of the same length as the input vector, with a TRUE for any elements that are missing, and a FALSE for non-missing elements. The sum() function can then be used to count all of the missing elements.

library(ISLR)

Attaching package: 㤼㸱ISLR㤼㸲

The following object is masked _by_ 㤼㸱.GlobalEnv㤼㸲:

    Hitters
str(Hitters)
'data.frame':   263 obs. of  20 variables:
 $ AtBat    : int  315 479 496 321 594 185 298 323 401 574 ...
 $ Hits     : int  81 130 141 87 169 37 73 81 92 159 ...
 $ HmRun    : int  7 18 20 10 4 1 0 6 17 21 ...
 $ Runs     : int  24 66 65 39 74 23 24 26 49 107 ...
 $ RBI      : int  38 72 78 42 51 8 24 32 66 75 ...
 $ Walks    : int  39 76 37 30 35 21 7 8 65 59 ...
 $ Years    : int  14 3 11 2 11 2 3 2 13 10 ...
 $ CAtBat   : int  3449 1624 5628 396 4408 214 509 341 5206 4631 ...
 $ CHits    : int  835 457 1575 101 1133 42 108 86 1332 1300 ...
 $ CHmRun   : int  69 63 225 12 19 1 0 6 253 90 ...
 $ CRuns    : int  321 224 828 48 501 30 41 32 784 702 ...
 $ CRBI     : int  414 266 838 46 336 9 37 34 890 504 ...
 $ CWalks   : int  375 263 354 33 194 24 12 8 866 488 ...
 $ League   : Factor w/ 2 levels "A","N": 2 1 2 2 1 2 1 2 1 1 ...
 $ Division : Factor w/ 2 levels "E","W": 2 2 1 1 2 1 2 2 1 1 ...
 $ PutOuts  : int  632 880 200 805 282 76 121 143 0 238 ...
 $ Assists  : int  43 82 11 40 421 127 283 290 0 445 ...
 $ Errors   : int  10 14 3 4 25 7 9 19 0 22 ...
 $ Salary   : num  475 480 500 91.5 750 ...
 $ NewLeague: Factor w/ 2 levels "A","N": 2 1 2 2 1 1 1 2 1 1 ...
 - attr(*, "na.action")= 'omit' Named int  1 16 19 23 31 33 37 39 40 42 ...
  ..- attr(*, "names")= chr  "-Andy Allanson" "-Billy Beane" "-Bruce Bochte" "-Bob Boone" ...
names(Hitters)
 [1] "AtBat"     "Hits"      "HmRun"     "Runs"      "RBI"       "Walks"     "Years"     "CAtBat"    "CHits"     "CHmRun"    "CRuns"     "CRBI"      "CWalks"    "League"    "Division" 
[16] "PutOuts"   "Assists"   "Errors"    "Salary"    "NewLeague"
dim(Hitters)
[1] 263  20
sum(is.na(Hitters$Salary))
[1] 0

Hence we see that Salary is missing for 59 players. The na.omit() function removes all of the rows that have missing values in any variable.

Hitters=na.omit(Hitters)
dim(Hitters)
[1] 263  20
sum(is.na(Hitters))
[1] 0

The regsubsets() function (part of the leaps library) performs best subset selection by identifying the best model that contains a given number of predictors, where best is quantified using RSS. The syntax is the same as for lm(). The summary() command outputs the best set of variables for each model size.

library(leaps)
regfit.full=regsubsets(Salary~.,Hitters)
summary(regfit.full)
Subset selection object
Call: regsubsets.formula(Salary ~ ., Hitters)
19 Variables  (and intercept)
           Forced in Forced out
AtBat          FALSE      FALSE
Hits           FALSE      FALSE
HmRun          FALSE      FALSE
Runs           FALSE      FALSE
RBI            FALSE      FALSE
Walks          FALSE      FALSE
Years          FALSE      FALSE
CAtBat         FALSE      FALSE
CHits          FALSE      FALSE
CHmRun         FALSE      FALSE
CRuns          FALSE      FALSE
CRBI           FALSE      FALSE
CWalks         FALSE      FALSE
LeagueN        FALSE      FALSE
DivisionW      FALSE      FALSE
PutOuts        FALSE      FALSE
Assists        FALSE      FALSE
Errors         FALSE      FALSE
NewLeagueN     FALSE      FALSE
1 subsets of each size up to 8
Selection Algorithm: exhaustive
         AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun CRuns CRBI CWalks LeagueN DivisionW PutOuts Assists Errors NewLeagueN
1  ( 1 ) " "   " "  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     " "       " "     " "     " "    " "       
2  ( 1 ) " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     " "       " "     " "     " "    " "       
3  ( 1 ) " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     " "       "*"     " "     " "    " "       
4  ( 1 ) " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     "*"       "*"     " "     " "    " "       
5  ( 1 ) "*"   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     "*"       "*"     " "     " "    " "       
6  ( 1 ) "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    " "   "*"  " "    " "     "*"       "*"     " "     " "    " "       
7  ( 1 ) " "   "*"  " "   " "  " " "*"   " "   "*"    "*"   "*"    " "   " "  " "    " "     "*"       "*"     " "     " "    " "       
8  ( 1 ) "*"   "*"  " "   " "  " " "*"   " "   " "    " "   "*"    "*"   " "  "*"    " "     "*"       "*"     " "     " "    " "       

An asterisk indicates that a given variable is included in the corresponding model. For instance, this output indicates that the best two-variable model contains only Hits and CRBI. By default, regsubsets() only reports results up to the best eight-variable model. But the nvmax option can be used in order to return as many variables as are desired. Here we fit up to a 19-variable model.

regfit.full=regsubsets(Salary~.,data=Hitters, nvmax=19)
reg.summary=summary(regfit.full)

The summary() function also returns \(R^2\), \(RSS\), adjusted \(R^2\), \(C_p\), and \(BIC\). We can examine these to try to select the best overall model.

names(reg.summary)
[1] "which"  "rsq"    "rss"    "adjr2"  "cp"     "bic"    "outmat" "obj"   

For instance, we see that the \(R^2\) statistic increases from 32%, when only one variable is included in the model, to almost 55%, when all variables are included. As expected, the \(R^2\) statistic increases monotonically as more variables are included.

reg.summary$rsq
 [1] 0.3214501 0.4252237 0.4514294 0.4754067 0.4908036 0.5087146 0.5141227 0.5285569 0.5346124 0.5404950 0.5426153 0.5436302 0.5444570 0.5452164 0.5454692 0.5457656 0.5459518 0.5460945
[19] 0.5461159

Plotting \(RSS\), adjusted \(R^2\), \(C_p\), and \(BIC\) for all of the models at once will help us decide which model to select. Note the type="l" option tells R to connect the plotted points with lines. The points() command works like the plot() command, except that it points() puts points on a plot that has already been created, instead of creating a new plot. The which.max() function can be used to identify the location of the maximum point of a vector. We will now plot a red dot to indicate the model with the largest adjusted \(R^2\) statistic.

par(mfrow=c(2,2))
plot(reg.summary$rss, xlab="Number of Variables ", ylab="RSS", type="l")
plot(reg.summary$adjr2, xlab="Number of Variables ", ylab="Adjusted RSq",type="l")
which.max(reg.summary$adjr2)
[1] 11
points(11,reg.summary$adjr2[11], col="red", cex=2, pch =20)
plot(reg.summary$cp,xlab="Number of Variables ",ylab="Cp",type='l')
which.min(reg.summary$cp)
[1] 10
points(10,reg.summary$cp[10], col ="red", cex=2, pch =20)
which.min(reg.summary$bic)
[1] 6
plot(reg.summary$bic ,xlab="Number of Variables ", ylab="BIC", type='l')
points (6,reg.summary$bic [6],col="red",cex=2,pch =20)

Plotting the \(C_p\) and \(BIC\) statistics is similar fashion, the main difference is using the which.min function instead of which.max indicating we want the smallest value for these statistics.

The regsubsets() function has a built-in plot() command which can be used to display the selected variables for the best model with a given number of predictors, ranked according to the \(BIC\), \(C_p\), adjusted \(R^2\), or \(AIC\). To find out more about this function, type ?plot.regsubsets.

par(mfrow=c(1,4),mar=c(0,0,0,0))
plot(regfit.full ,scale="r2")
plot(regfit.full ,scale="adjr2")
plot(regfit.full ,scale="Cp")
plot(regfit.full ,scale="bic")

The top row of each plot contains a black square for each variable selected according to the optimal model associated with that statistic. For instance, we see that several models share a \(BIC\) close to -150. However, the model with the lowest BIC is the six-variable model that contains only AtBat, Hits, Walks, CRBI, DivisionW, and PutOuts. We can use the coef() function to see the coefficient estimates associated with this model.

coef(regfit.full ,6)
 (Intercept)        AtBat         Hits        Walks         CRBI    DivisionW      PutOuts 
  91.5117981   -1.8685892    7.6043976    3.6976468    0.6430169 -122.9515338    0.2643076 

Forward and Backward Stepwise Selection

We can also use the regsubsets() function to perform forward stepwise or backward stepwise selection, using the argument method="forward" or method="backward".

regfit.fwd=regsubsets(Salary~., data=Hitters, nvmax=19, method ="forward")
summary(regfit.fwd)
Subset selection object
Call: regsubsets.formula(Salary ~ ., data = Hitters, nvmax = 19, method = "forward")
19 Variables  (and intercept)
           Forced in Forced out
AtBat          FALSE      FALSE
Hits           FALSE      FALSE
HmRun          FALSE      FALSE
Runs           FALSE      FALSE
RBI            FALSE      FALSE
Walks          FALSE      FALSE
Years          FALSE      FALSE
CAtBat         FALSE      FALSE
CHits          FALSE      FALSE
CHmRun         FALSE      FALSE
CRuns          FALSE      FALSE
CRBI           FALSE      FALSE
CWalks         FALSE      FALSE
LeagueN        FALSE      FALSE
DivisionW      FALSE      FALSE
PutOuts        FALSE      FALSE
Assists        FALSE      FALSE
Errors         FALSE      FALSE
NewLeagueN     FALSE      FALSE
1 subsets of each size up to 19
Selection Algorithm: forward
          AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun CRuns CRBI CWalks LeagueN DivisionW PutOuts Assists Errors NewLeagueN
1  ( 1 )  " "   " "  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     " "       " "     " "     " "    " "       
2  ( 1 )  " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     " "       " "     " "     " "    " "       
3  ( 1 )  " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     " "       "*"     " "     " "    " "       
4  ( 1 )  " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     "*"       "*"     " "     " "    " "       
5  ( 1 )  "*"   "*"  " "   " "  " " " "   " "   " "    " "   " "    " "   "*"  " "    " "     "*"       "*"     " "     " "    " "       
6  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    " "   "*"  " "    " "     "*"       "*"     " "     " "    " "       
7  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    " "   "*"  "*"    " "     "*"       "*"     " "     " "    " "       
8  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    "*"   "*"  "*"    " "     "*"       "*"     " "     " "    " "       
9  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    " "     "*"       "*"     " "     " "    " "       
10  ( 1 ) "*"   "*"  " "   " "  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    " "     "*"       "*"     "*"     " "    " "       
11  ( 1 ) "*"   "*"  " "   " "  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     " "    " "       
12  ( 1 ) "*"   "*"  " "   "*"  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     " "    " "       
13  ( 1 ) "*"   "*"  " "   "*"  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
14  ( 1 ) "*"   "*"  "*"   "*"  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
15  ( 1 ) "*"   "*"  "*"   "*"  " " "*"   " "   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
16  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   " "   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
17  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   " "   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    "*"       
18  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   "*"   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    "*"       
19  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   "*"   "*"    "*"   "*"    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    "*"       
regfit.bwd=regsubsets(Salary~., data=Hitters, nvmax=19, method ="backward")
summary(regfit.bwd)
Subset selection object
Call: regsubsets.formula(Salary ~ ., data = Hitters, nvmax = 19, method = "backward")
19 Variables  (and intercept)
           Forced in Forced out
AtBat          FALSE      FALSE
Hits           FALSE      FALSE
HmRun          FALSE      FALSE
Runs           FALSE      FALSE
RBI            FALSE      FALSE
Walks          FALSE      FALSE
Years          FALSE      FALSE
CAtBat         FALSE      FALSE
CHits          FALSE      FALSE
CHmRun         FALSE      FALSE
CRuns          FALSE      FALSE
CRBI           FALSE      FALSE
CWalks         FALSE      FALSE
LeagueN        FALSE      FALSE
DivisionW      FALSE      FALSE
PutOuts        FALSE      FALSE
Assists        FALSE      FALSE
Errors         FALSE      FALSE
NewLeagueN     FALSE      FALSE
1 subsets of each size up to 19
Selection Algorithm: backward
          AtBat Hits HmRun Runs RBI Walks Years CAtBat CHits CHmRun CRuns CRBI CWalks LeagueN DivisionW PutOuts Assists Errors NewLeagueN
1  ( 1 )  " "   " "  " "   " "  " " " "   " "   " "    " "   " "    "*"   " "  " "    " "     " "       " "     " "     " "    " "       
2  ( 1 )  " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    "*"   " "  " "    " "     " "       " "     " "     " "    " "       
3  ( 1 )  " "   "*"  " "   " "  " " " "   " "   " "    " "   " "    "*"   " "  " "    " "     " "       "*"     " "     " "    " "       
4  ( 1 )  "*"   "*"  " "   " "  " " " "   " "   " "    " "   " "    "*"   " "  " "    " "     " "       "*"     " "     " "    " "       
5  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    "*"   " "  " "    " "     " "       "*"     " "     " "    " "       
6  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    "*"   " "  " "    " "     "*"       "*"     " "     " "    " "       
7  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    "*"   " "  "*"    " "     "*"       "*"     " "     " "    " "       
8  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   " "    " "   " "    "*"   "*"  "*"    " "     "*"       "*"     " "     " "    " "       
9  ( 1 )  "*"   "*"  " "   " "  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    " "     "*"       "*"     " "     " "    " "       
10  ( 1 ) "*"   "*"  " "   " "  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    " "     "*"       "*"     "*"     " "    " "       
11  ( 1 ) "*"   "*"  " "   " "  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     " "    " "       
12  ( 1 ) "*"   "*"  " "   "*"  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     " "    " "       
13  ( 1 ) "*"   "*"  " "   "*"  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
14  ( 1 ) "*"   "*"  "*"   "*"  " " "*"   " "   "*"    " "   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
15  ( 1 ) "*"   "*"  "*"   "*"  " " "*"   " "   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
16  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   " "   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    " "       
17  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   " "   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    "*"       
18  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   "*"   "*"    "*"   " "    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    "*"       
19  ( 1 ) "*"   "*"  "*"   "*"  "*" "*"   "*"   "*"    "*"   "*"    "*"   "*"  "*"    "*"     "*"       "*"     "*"     "*"    "*"       

For instance, we see that using forward stepwise selection, the best onevariable model contains only CRBI, and the best two-variable model additionally includes Hits. For this data, the best one-variable through sixvariable models are each identical for best subset and forward selection. However, the best seven-variable models identified by forward stepwise selection, backward stepwise selection, and best subset selection are different.

coef(regfit.full,7)
 (Intercept)         Hits        Walks       CAtBat        CHits       CHmRun    DivisionW      PutOuts 
  79.4509472    1.2833513    3.2274264   -0.3752350    1.4957073    1.4420538 -129.9866432    0.2366813 
coef(regfit.fwd, 7)
 (Intercept)        AtBat         Hits        Walks         CRBI       CWalks    DivisionW      PutOuts 
 109.7873062   -1.9588851    7.4498772    4.9131401    0.8537622   -0.3053070 -127.1223928    0.2533404 
coef(regfit.bwd, 7)
 (Intercept)        AtBat         Hits        Walks        CRuns       CWalks    DivisionW      PutOuts 
 105.6487488   -1.9762838    6.7574914    6.0558691    1.1293095   -0.7163346 -116.1692169    0.3028847 

Choosing Among Models Using the Validation Set Approach and Cross-Validation

We just saw that it is possible to choose among a set of models of different sizes using \(C_p\), \(BIC\), and adjusted \(R^2\). We will now consider how to do this using the validation set and cross-validation approaches.

In order for these approaches to yield accurate estimates of the test error, we must use only the training observations to perform all aspects of model-fitting-including variable selection. Therefore, the determination of which model of a given size is best must be made using only the training observations. This point is subtle but important. If the full data set is used to perform the best subset selection step, the validation set errors and cross-validation errors that we obtain will not be accurate estimates of the test error.

In order to use the validation set approach, we begin by splitting the observations into a training set and a test set. We do this by creating a random vector, train, of elements equal to TRUE if the corresponding observation is in the training set, and FALSE otherwise. The vector test has a TRUE if the observation is in the test set, and a FALSE otherwise. Note the ! in the command to create test causes TRUEs to be switched to FALSEs and vice versa. We also set a random seed so that the user will obtain the same training set/test set split.

set.seed(1)
train=sample(c(TRUE ,FALSE), nrow(Hitters),rep=TRUE)
test=(!train)

Now, we apply regsubsets() to the training set in order to perform best subset selection.

regfit.best=regsubsets(Salary~.,data=Hitters[train,],nvmax=19)

Notice that we subset the Hitters data frame directly in the call in order to access only the training subset of the data, using the expression Hitters[train,]. We now compute the validation set error for the best model of each model size. We first make a model matrix from the test data.

test.mat=model.matrix(Salary~.,data=Hitters [test ,])

The model.matrix() function is used in many regression packages for building an “X” matrix from data. Now we run a loop, and for each size i, we extract the coefficients from regfit.best for the best model of that size, multiply them into the appropriate columns of the test model matrix to form the predictions, and compute the test MSE.

val.errors =rep(NA ,19)
for(i in 1:19){
 coefi=coef(regfit.best ,id=i)
 pred=test.mat[,names(coefi)]%*%coefi
 val.errors[i]=mean(( Hitters$Salary[test]-pred)^2)
}

We find that the best model is the one that contains ten variables.

val.errors
 [1] 164377.3 144405.5 152175.7 145198.4 137902.1 139175.7 126849.0 136191.4 132889.6 135434.9 136963.3 140694.9 140690.9 141951.2 141508.2 142164.4 141767.4 142339.6 142238.2
which.min(val.errors)
[1] 7
coef(regfit.best,10)
 (Intercept)        AtBat         Hits        HmRun        Walks       CAtBat        CRuns         CRBI       CWalks    DivisionW      PutOuts 
  71.8074075   -1.5038124    5.9130470  -11.5241809    8.4349759   -0.1654850    1.7064330    0.7903694   -0.9107515 -109.5616997    0.2426078 

This was a little tedious, partly because there is no predict() method for regsubsets(). Since we will be using this function again, we can capture our steps above and write our own predict method.

predict.regsubsets=function(object , newdata ,id ,...){
 form=as.formula (object$call [[2]])
 mat=model.matrix(form ,newdata )
 coefi=coef(object ,id=id)
 xvars=names(coefi)
 mat[,xvars]%*%coefi
}

Our function pretty much mimics what we did above. The only complex part is how we extracted the formula used in the call to regsubsets(). We demonstrate how we use this function below, when we do cross-validation.

Finally, we perform best subset selection on the full data set, and select the best ten-variable model. It is important that we make use of the full data set in order to obtain more accurate coefficient estimates. Note that we perform best subset selection on the full data set and select the best tenvariable model, rather than simply using the variables that were obtained from the training set, because the best ten-variable model on the full data set may differ from the corresponding model on the training set.

regfit.best=regsubsets(Salary~.,data=Hitters,nvmax=19)
coef(regfit.best ,10)
 (Intercept)        AtBat         Hits        Walks       CAtBat        CRuns         CRBI       CWalks    DivisionW      PutOuts      Assists 
 162.5354420   -2.1686501    6.9180175    5.7732246   -0.1300798    1.4082490    0.7743122   -0.8308264 -112.3800575    0.2973726    0.2831680 

In fact, we see that the best ten-variable model on the full data set has a different set of variables than the best ten-variable model on the training set.

We now try to choose among the models of different sizes using crossvalidation. This approach is somewhat involved, as we must perform best subset selection within each of the k training sets. Despite this, we see that with its clever subsetting syntax, R makes this job quite easy. First, we create a vector that allocates each observation to one of k = 10 folds, and we create a matrix in which we will store the results.

k=10
set.seed(1)
folds=sample (1:k,nrow(Hitters),replace=TRUE)
cv.errors=matrix(NA,k,19, dimnames=list(NULL,paste(1:19)))

Now we write a for loop that performs cross-validation. In the jth fold, the elements of folds that equal j are in the test set, and the remainder are in the training set. We make our predictions for each model size (using our new predict() method), compute the test errors on the appropriate subset, and store them in the appropriate slot in the matrix cv.errors.

for(j in 1:k){
 best.fit=regsubsets (Salary~.,data=Hitters[folds!=j,],nvmax=19)
 for(i in 1:19){
  pred=predict (best.fit ,Hitters [folds ==j,],id=i)
  cv.errors[j,i]= mean( ( Hitters$Salary[ folds==j]-pred)^2)
 }
}

This has given us a 10x19 matrix, of which the (i, j)th element corresponds to the test MSE for the ith cross-validation fold for the best j-variable model. We use the apply() function to average over the columns of this matrix in order to obtain a vector for which the jth element is the crossvalidation error for the j-variable model.

mean.cv.errors=apply(cv.errors ,2, mean)
mean.cv.errors
       1        2        3        4        5        6        7        8        9       10       11       12       13       14       15       16       17       18       19 
149821.1 130922.0 139127.0 131028.8 131050.2 119538.6 124286.1 113580.0 115556.5 112216.7 113251.2 115755.9 117820.8 119481.2 120121.6 120074.3 120084.8 120085.8 120403.5 
par(mfrow=c(1,1))
plot(mean.cv.errors ,type='b')

We see that cross-validation selects an 11-variable model. We now perform best subset selection on the full data set in order to obtain the 11-variable model.

reg.best=regsubsets (Salary~.,data=Hitters, nvmax=19)
coef(reg.best ,11)
 (Intercept)        AtBat         Hits        Walks       CAtBat        CRuns         CRBI       CWalks      LeagueN    DivisionW      PutOuts      Assists 
 135.7512195   -2.1277482    6.9236994    5.6202755   -0.1389914    1.4553310    0.7852528   -0.8228559   43.1116152 -111.1460252    0.2894087    0.2688277 
LS0tDQp0aXRsZTogIlN1YnNldCBTZWxlY3Rpb24gTWV0aG9kcyINCm91dHB1dDogDQogIGh0bWxfbm90ZWJvb2s6DQogICAgdG9jOiB0cnVlDQotLS0NCg0KIyMgQmVzdCBTdWJzZXQgU2VsZWN0aW9uDQpIZXJlIHdlIGFwcGx5IHRoZSBiZXN0IHN1YnNldCBzZWxlY3Rpb24gYXBwcm9hY2ggdG8gdGhlIFtIaXR0ZXJzXShodHRwczovL3JkcnIuaW8vY3Jhbi9JU0xSL21hbi9IaXR0ZXJzLmh0bWwpIGRhdGEuIFdlIHdpc2ggdG8gcHJlZGljdCBhIGJhc2ViYWxsIHBsYXllcidzIGBTYWxhcnlgIG9uIHRoZSBiYXNpcyBvZiB2YXJpb3VzIHN0YXRpc3RpY3MgYXNzb2NpYXRlZCB3aXRoIHBlcmZvcm1hbmNlIGluIHRoZSBwcmV2aW91cyB5ZWFyLg0KDQpGaXJzdCBvZiBhbGwsIHdlIG5vdGUgdGhhdCB0aGUgYFNhbGFyeWAgdmFyaWFibGUgaXMgbWlzc2luZyBmb3Igc29tZSBvZiB0aGUgcGxheWVycy4gVGhlIGBpcy5uYSgpYCBmdW5jdGlvbiBjYW4gYmUgdXNlZCB0byBpZGVudGlmeSB0aGUgbWlzc2luZyBvYnNlcnZhdGlvbnMuIEl0IHJldHVybnMgYSB2ZWN0b3Igb2YgdGhlIHNhbWUgbGVuZ3RoIGFzIHRoZSBpbnB1dCB2ZWN0b3IsIHdpdGggYSBgVFJVRWAgZm9yIGFueSBlbGVtZW50cyB0aGF0IGFyZSBtaXNzaW5nLCBhbmQgYSBgRkFMU0VgIGZvciBub24tbWlzc2luZyBlbGVtZW50cy4gVGhlIGBzdW0oKWAgZnVuY3Rpb24gY2FuIHRoZW4gYmUgdXNlZCB0byBjb3VudCBhbGwgb2YgdGhlIG1pc3NpbmcgZWxlbWVudHMuDQoNCmBgYHtyIG1pc3Npbmd9DQpsaWJyYXJ5KElTTFIpDQpzdHIoSGl0dGVycykNCm5hbWVzKEhpdHRlcnMpDQpkaW0oSGl0dGVycykNCnN1bShpcy5uYShIaXR0ZXJzJFNhbGFyeSkpDQpgYGANCg0KSGVuY2Ugd2Ugc2VlIHRoYXQgYFNhbGFyeWAgaXMgbWlzc2luZyBmb3IgNTkgcGxheWVycy4gVGhlIGBuYS5vbWl0KClgIGZ1bmN0aW9uIHJlbW92ZXMgYWxsIG9mIHRoZSByb3dzIHRoYXQgaGF2ZSBtaXNzaW5nIHZhbHVlcyBpbiBhbnkgdmFyaWFibGUuDQoNCmBgYHtyIG9taXR9DQpIaXR0ZXJzPW5hLm9taXQoSGl0dGVycykNCmRpbShIaXR0ZXJzKQ0Kc3VtKGlzLm5hKEhpdHRlcnMpKQ0KYGBgDQoNClRoZSBgcmVnc3Vic2V0cygpYCBmdW5jdGlvbiAocGFydCBvZiB0aGUgYGxlYXBzYCBsaWJyYXJ5KSBwZXJmb3JtcyBiZXN0IHN1YnNldCBzZWxlY3Rpb24gYnkgaWRlbnRpZnlpbmcgdGhlIGJlc3QgbW9kZWwgdGhhdCBjb250YWlucyBhIGdpdmVuIG51bWJlciBvZiBwcmVkaWN0b3JzLCB3aGVyZSBiZXN0IGlzIHF1YW50aWZpZWQgdXNpbmcgUlNTLiBUaGUgc3ludGF4IGlzIHRoZSBzYW1lIGFzIGZvciBgbG0oKWAuIFRoZSBgc3VtbWFyeSgpYCBjb21tYW5kIG91dHB1dHMgdGhlIGJlc3Qgc2V0IG9mIHZhcmlhYmxlcyBmb3IgZWFjaCBtb2RlbCBzaXplLg0KDQpgYGB7ciBsZWFwc30NCmxpYnJhcnkobGVhcHMpDQpyZWdmaXQuZnVsbD1yZWdzdWJzZXRzKFNhbGFyeX4uLEhpdHRlcnMpDQpzdW1tYXJ5KHJlZ2ZpdC5mdWxsKQ0KYGBgDQoNCkFuIGFzdGVyaXNrIGluZGljYXRlcyB0aGF0IGEgZ2l2ZW4gdmFyaWFibGUgaXMgaW5jbHVkZWQgaW4gdGhlIGNvcnJlc3BvbmRpbmcgbW9kZWwuIEZvciBpbnN0YW5jZSwgdGhpcyBvdXRwdXQgaW5kaWNhdGVzIHRoYXQgdGhlIGJlc3QgdHdvLXZhcmlhYmxlIG1vZGVsIGNvbnRhaW5zIG9ubHkgYEhpdHNgIGFuZCBgQ1JCSWAuIEJ5IGRlZmF1bHQsIGByZWdzdWJzZXRzKClgIG9ubHkgcmVwb3J0cyByZXN1bHRzIHVwIHRvIHRoZSBiZXN0IGVpZ2h0LXZhcmlhYmxlIG1vZGVsLiBCdXQgdGhlIGBudm1heGAgb3B0aW9uIGNhbiBiZSB1c2VkIGluIG9yZGVyIHRvIHJldHVybiBhcyBtYW55IHZhcmlhYmxlcyBhcyBhcmUgZGVzaXJlZC4gSGVyZSB3ZSBmaXQgdXAgdG8gYSAxOS12YXJpYWJsZSBtb2RlbC4NCg0KYGBge3IgYWxsMTl9DQpyZWdmaXQuZnVsbD1yZWdzdWJzZXRzKFNhbGFyeX4uLGRhdGE9SGl0dGVycywgbnZtYXg9MTkpDQpyZWcuc3VtbWFyeT1zdW1tYXJ5KHJlZ2ZpdC5mdWxsKQ0KYGBgDQoNClRoZSBgc3VtbWFyeSgpYCBmdW5jdGlvbiBhbHNvIHJldHVybnMgJFJeMiQsICRSU1MkLCBhZGp1c3RlZCAkUl4yJCwgJENfcCQsIGFuZCAkQklDJC4gV2UgY2FuIGV4YW1pbmUgdGhlc2UgdG8gdHJ5IHRvIHNlbGVjdCB0aGUgYmVzdCBvdmVyYWxsIG1vZGVsLg0KDQpgYGB7ciBzdWJzZXRzdW19DQpuYW1lcyhyZWcuc3VtbWFyeSkNCmBgYA0KRm9yIGluc3RhbmNlLCB3ZSBzZWUgdGhhdCB0aGUgJFJeMiQgc3RhdGlzdGljIGluY3JlYXNlcyBmcm9tIDMyJSwgd2hlbiBvbmx5IG9uZSB2YXJpYWJsZSBpcyBpbmNsdWRlZCBpbiB0aGUgbW9kZWwsIHRvIGFsbW9zdCA1NSUsIHdoZW4gYWxsIHZhcmlhYmxlcyBhcmUgaW5jbHVkZWQuIEFzIGV4cGVjdGVkLCB0aGUgJFJeMiQgc3RhdGlzdGljIGluY3JlYXNlcyBtb25vdG9uaWNhbGx5IGFzIG1vcmUgdmFyaWFibGVzIGFyZSBpbmNsdWRlZC4NCg0KYGBge3IgcnNxfQ0KcmVnLnN1bW1hcnkkcnNxDQpgYGANCg0KUGxvdHRpbmcgJFJTUyQsIGFkanVzdGVkICRSXjIkLCAkQ19wJCwgYW5kICRCSUMkIGZvciBhbGwgb2YgdGhlIG1vZGVscyBhdCBvbmNlIHdpbGwgaGVscCB1cyBkZWNpZGUgd2hpY2ggbW9kZWwgdG8gc2VsZWN0LiBOb3RlIHRoZSBgdHlwZT0ibCJgIG9wdGlvbiB0ZWxscyBgUmAgdG8gY29ubmVjdCB0aGUgcGxvdHRlZCBwb2ludHMgd2l0aCBsaW5lcy4gVGhlIGBwb2ludHMoKWAgY29tbWFuZCB3b3JrcyBsaWtlIHRoZSBwbG90KCkgY29tbWFuZCwgZXhjZXB0IHRoYXQgaXQgcG9pbnRzKCkgcHV0cyBwb2ludHMgb24gYSBwbG90IHRoYXQgaGFzIGFscmVhZHkgYmVlbiBjcmVhdGVkLCBpbnN0ZWFkIG9mIGNyZWF0aW5nIGEgbmV3IHBsb3QuIFRoZSBgd2hpY2gubWF4KClgIGZ1bmN0aW9uIGNhbiBiZSB1c2VkIHRvIGlkZW50aWZ5IHRoZSBsb2NhdGlvbiBvZiB0aGUgbWF4aW11bSBwb2ludCBvZiBhIHZlY3Rvci4gV2Ugd2lsbCBub3cgcGxvdCBhIHJlZCBkb3QgdG8gaW5kaWNhdGUgdGhlIG1vZGVsIHdpdGggdGhlIGxhcmdlc3QgYWRqdXN0ZWQgJFJeMiQgc3RhdGlzdGljLg0KDQpgYGB7ciBwbG90aXR9DQpwYXIobWZyb3c9YygyLDIpKQ0KcGxvdChyZWcuc3VtbWFyeSRyc3MsIHhsYWI9Ik51bWJlciBvZiBWYXJpYWJsZXMgIiwgeWxhYj0iUlNTIiwgdHlwZT0ibCIpDQpwbG90KHJlZy5zdW1tYXJ5JGFkanIyLCB4bGFiPSJOdW1iZXIgb2YgVmFyaWFibGVzICIsIHlsYWI9IkFkanVzdGVkIFJTcSIsdHlwZT0ibCIpDQp3aGljaC5tYXgocmVnLnN1bW1hcnkkYWRqcjIpDQpwb2ludHMoMTEscmVnLnN1bW1hcnkkYWRqcjJbMTFdLCBjb2w9InJlZCIsIGNleD0yLCBwY2ggPTIwKQ0KcGxvdChyZWcuc3VtbWFyeSRjcCx4bGFiPSJOdW1iZXIgb2YgVmFyaWFibGVzICIseWxhYj0iQ3AiLHR5cGU9J2wnKQ0Kd2hpY2gubWluKHJlZy5zdW1tYXJ5JGNwKQ0KcG9pbnRzKDEwLHJlZy5zdW1tYXJ5JGNwWzEwXSwgY29sID0icmVkIiwgY2V4PTIsIHBjaCA9MjApDQp3aGljaC5taW4ocmVnLnN1bW1hcnkkYmljKQ0KcGxvdChyZWcuc3VtbWFyeSRiaWMgLHhsYWI9Ik51bWJlciBvZiBWYXJpYWJsZXMgIiwgeWxhYj0iQklDIiwgdHlwZT0nbCcpDQpwb2ludHMgKDYscmVnLnN1bW1hcnkkYmljIFs2XSxjb2w9InJlZCIsY2V4PTIscGNoID0yMCkNCmBgYA0KDQpQbG90dGluZyB0aGUgJENfcCQgYW5kICRCSUMkIHN0YXRpc3RpY3MgaXMgc2ltaWxhciBmYXNoaW9uLCB0aGUgbWFpbiBkaWZmZXJlbmNlIGlzIHVzaW5nIHRoZSBgd2hpY2gubWluYCBmdW5jdGlvbiBpbnN0ZWFkIG9mIGB3aGljaC5tYXhgIGluZGljYXRpbmcgd2Ugd2FudCB0aGUgc21hbGxlc3QgdmFsdWUgZm9yIHRoZXNlIHN0YXRpc3RpY3MuDQoNClRoZSBgcmVnc3Vic2V0cygpYCBmdW5jdGlvbiBoYXMgYSBidWlsdC1pbiBgcGxvdCgpYCBjb21tYW5kIHdoaWNoIGNhbiBiZSB1c2VkIHRvIGRpc3BsYXkgdGhlIHNlbGVjdGVkIHZhcmlhYmxlcyBmb3IgdGhlIGJlc3QgbW9kZWwgd2l0aCBhIGdpdmVuIG51bWJlciBvZiBwcmVkaWN0b3JzLCByYW5rZWQgYWNjb3JkaW5nIHRvIHRoZSAkQklDJCwgJENfcCQsIGFkanVzdGVkICRSXjIkLCBvciAkQUlDJC4gVG8gZmluZCBvdXQgbW9yZSBhYm91dCB0aGlzIGZ1bmN0aW9uLCB0eXBlIGA/cGxvdC5yZWdzdWJzZXRzYC4NCg0KYGBge3IgcGxvdHN0YXR9DQpwYXIobWZyb3c9YygxLDQpLG1hcj1jKDAsMCwwLDApKQ0KcGxvdChyZWdmaXQuZnVsbCAsc2NhbGU9InIyIikNCnBsb3QocmVnZml0LmZ1bGwgLHNjYWxlPSJhZGpyMiIpDQpwbG90KHJlZ2ZpdC5mdWxsICxzY2FsZT0iQ3AiKQ0KcGxvdChyZWdmaXQuZnVsbCAsc2NhbGU9ImJpYyIpDQpgYGANCg0KVGhlIHRvcCByb3cgb2YgZWFjaCBwbG90IGNvbnRhaW5zIGEgYmxhY2sgc3F1YXJlIGZvciBlYWNoIHZhcmlhYmxlIHNlbGVjdGVkIGFjY29yZGluZyB0byB0aGUgb3B0aW1hbCBtb2RlbCBhc3NvY2lhdGVkIHdpdGggdGhhdCBzdGF0aXN0aWMuIEZvciBpbnN0YW5jZSwgd2Ugc2VlIHRoYXQgc2V2ZXJhbCBtb2RlbHMgc2hhcmUgYSAkQklDJCBjbG9zZSB0byAtMTUwLiBIb3dldmVyLCB0aGUgbW9kZWwgd2l0aCB0aGUgbG93ZXN0IEJJQyBpcyB0aGUgc2l4LXZhcmlhYmxlIG1vZGVsIHRoYXQgY29udGFpbnMgb25seSBgQXRCYXRgLCBgSGl0c2AsIGBXYWxrc2AsIGBDUkJJYCwgYERpdmlzaW9uV2AsIGFuZCBgUHV0T3V0c2AuIFdlIGNhbiB1c2UgdGhlIGBjb2VmKClgIGZ1bmN0aW9uIHRvIHNlZSB0aGUgY29lZmZpY2llbnQgZXN0aW1hdGVzIGFzc29jaWF0ZWQgd2l0aCB0aGlzIG1vZGVsLg0KDQpgYGB7ciB9DQpjb2VmKHJlZ2ZpdC5mdWxsICw2KQ0KYGBgDQoNCiMjIEZvcndhcmQgYW5kIEJhY2t3YXJkIFN0ZXB3aXNlIFNlbGVjdGlvbg0KV2UgY2FuIGFsc28gdXNlIHRoZSBgcmVnc3Vic2V0cygpYCBmdW5jdGlvbiB0byBwZXJmb3JtIGZvcndhcmQgc3RlcHdpc2Ugb3IgYmFja3dhcmQgc3RlcHdpc2Ugc2VsZWN0aW9uLCB1c2luZyB0aGUgYXJndW1lbnQgYG1ldGhvZD0iZm9yd2FyZCJgIG9yIGBtZXRob2Q9ImJhY2t3YXJkImAuDQoNCmBgYHtyIHN0ZXB9DQpyZWdmaXQuZndkPXJlZ3N1YnNldHMoU2FsYXJ5fi4sIGRhdGE9SGl0dGVycywgbnZtYXg9MTksIG1ldGhvZCA9ImZvcndhcmQiKQ0Kc3VtbWFyeShyZWdmaXQuZndkKQ0KcmVnZml0LmJ3ZD1yZWdzdWJzZXRzKFNhbGFyeX4uLCBkYXRhPUhpdHRlcnMsIG52bWF4PTE5LCBtZXRob2QgPSJiYWNrd2FyZCIpDQpzdW1tYXJ5KHJlZ2ZpdC5id2QpDQpgYGANCg0KRm9yIGluc3RhbmNlLCB3ZSBzZWUgdGhhdCB1c2luZyBmb3J3YXJkIHN0ZXB3aXNlIHNlbGVjdGlvbiwgdGhlIGJlc3Qgb25ldmFyaWFibGUgbW9kZWwgY29udGFpbnMgb25seSBgQ1JCSWAsIGFuZCB0aGUgYmVzdCB0d28tdmFyaWFibGUgbW9kZWwgYWRkaXRpb25hbGx5IGluY2x1ZGVzIGBIaXRzYC4gRm9yIHRoaXMgZGF0YSwgdGhlIGJlc3Qgb25lLXZhcmlhYmxlIHRocm91Z2ggc2l4dmFyaWFibGUgbW9kZWxzIGFyZSBlYWNoIGlkZW50aWNhbCBmb3IgYmVzdCBzdWJzZXQgYW5kIGZvcndhcmQgc2VsZWN0aW9uLiBIb3dldmVyLCB0aGUgYmVzdCBzZXZlbi12YXJpYWJsZSBtb2RlbHMgaWRlbnRpZmllZCBieSBmb3J3YXJkIHN0ZXB3aXNlIHNlbGVjdGlvbiwgYmFja3dhcmQgc3RlcHdpc2Ugc2VsZWN0aW9uLCBhbmQgYmVzdCBzdWJzZXQgc2VsZWN0aW9uIGFyZSBkaWZmZXJlbnQuDQoNCmBgYHtyIGJlc3Q3fQ0KY29lZihyZWdmaXQuZnVsbCw3KQ0KY29lZihyZWdmaXQuZndkLCA3KQ0KY29lZihyZWdmaXQuYndkLCA3KQ0KYGBgDQoNCiMjIENob29zaW5nIEFtb25nIE1vZGVscyBVc2luZyB0aGUgVmFsaWRhdGlvbiBTZXQgQXBwcm9hY2ggYW5kIENyb3NzLVZhbGlkYXRpb24NCldlIGp1c3Qgc2F3IHRoYXQgaXQgaXMgcG9zc2libGUgdG8gY2hvb3NlIGFtb25nIGEgc2V0IG9mIG1vZGVscyBvZiBkaWZmZXJlbnQgc2l6ZXMgdXNpbmcgJENfcCQsICRCSUMkLCBhbmQgYWRqdXN0ZWQgJFJeMiQuIFdlIHdpbGwgbm93IGNvbnNpZGVyIGhvdyB0byBkbyB0aGlzIHVzaW5nIHRoZSB2YWxpZGF0aW9uIHNldCBhbmQgY3Jvc3MtdmFsaWRhdGlvbiBhcHByb2FjaGVzLg0KDQpJbiBvcmRlciBmb3IgdGhlc2UgYXBwcm9hY2hlcyB0byB5aWVsZCBhY2N1cmF0ZSBlc3RpbWF0ZXMgb2YgdGhlIHRlc3QgZXJyb3IsIHdlIG11c3QgdXNlIG9ubHkgdGhlIHRyYWluaW5nIG9ic2VydmF0aW9ucyB0byBwZXJmb3JtIGFsbCBhc3BlY3RzIG9mDQptb2RlbC1maXR0aW5nLWluY2x1ZGluZyB2YXJpYWJsZSBzZWxlY3Rpb24uIFRoZXJlZm9yZSwgdGhlIGRldGVybWluYXRpb24gb2Ygd2hpY2ggbW9kZWwgb2YgYSBnaXZlbiBzaXplIGlzIGJlc3QgbXVzdCBiZSBtYWRlIHVzaW5nICpvbmx5IHRoZSB0cmFpbmluZw0Kb2JzZXJ2YXRpb25zKi4gVGhpcyBwb2ludCBpcyBzdWJ0bGUgYnV0IGltcG9ydGFudC4gSWYgdGhlIGZ1bGwgZGF0YSBzZXQgaXMgdXNlZCB0byBwZXJmb3JtIHRoZSBiZXN0IHN1YnNldCBzZWxlY3Rpb24gc3RlcCwgdGhlIHZhbGlkYXRpb24gc2V0IGVycm9ycyBhbmQgY3Jvc3MtdmFsaWRhdGlvbiBlcnJvcnMgdGhhdCB3ZSBvYnRhaW4gd2lsbCBub3QgYmUgYWNjdXJhdGUgZXN0aW1hdGVzIG9mIHRoZSB0ZXN0IGVycm9yLg0KDQpJbiBvcmRlciB0byB1c2UgdGhlIHZhbGlkYXRpb24gc2V0IGFwcHJvYWNoLCB3ZSBiZWdpbiBieSBzcGxpdHRpbmcgdGhlIG9ic2VydmF0aW9ucyBpbnRvIGEgdHJhaW5pbmcgc2V0IGFuZCBhIHRlc3Qgc2V0LiBXZSBkbyB0aGlzIGJ5IGNyZWF0aW5nIGEgcmFuZG9tIHZlY3RvciwgYHRyYWluYCwgb2YgZWxlbWVudHMgZXF1YWwgdG8gYFRSVUVgIGlmIHRoZSBjb3JyZXNwb25kaW5nIG9ic2VydmF0aW9uIGlzIGluIHRoZSB0cmFpbmluZyBzZXQsIGFuZCBgRkFMU0VgIG90aGVyd2lzZS4gVGhlIHZlY3RvciBgdGVzdGAgaGFzIGEgYFRSVUVgIGlmIHRoZSBvYnNlcnZhdGlvbiBpcyBpbiB0aGUgdGVzdCBzZXQsIGFuZCBhIGBGQUxTRWAgb3RoZXJ3aXNlLiBOb3RlIHRoZSAhIGluIHRoZSBjb21tYW5kIHRvIGNyZWF0ZSB0ZXN0IGNhdXNlcyBgVFJVRWBzIHRvIGJlIHN3aXRjaGVkIHRvIGBGQUxTRWBzIGFuZCB2aWNlIHZlcnNhLiBXZSBhbHNvIHNldCBhIHJhbmRvbSBzZWVkIHNvIHRoYXQgdGhlIHVzZXIgd2lsbCBvYnRhaW4gdGhlIHNhbWUgdHJhaW5pbmcgc2V0L3Rlc3Qgc2V0IHNwbGl0Lg0KDQpgYGB7ciB0cmFpbn0NCnNldC5zZWVkKDEpDQp0cmFpbj1zYW1wbGUoYyhUUlVFICxGQUxTRSksIG5yb3coSGl0dGVycykscmVwPVRSVUUpDQp0ZXN0PSghdHJhaW4pDQpgYGANCg0KTm93LCB3ZSBhcHBseSByZWdzdWJzZXRzKCkgdG8gdGhlIHRyYWluaW5nIHNldCBpbiBvcmRlciB0byBwZXJmb3JtIGJlc3Qgc3Vic2V0IHNlbGVjdGlvbi4NCg0KYGBge3IgcmVndHJhaW59DQpyZWdmaXQuYmVzdD1yZWdzdWJzZXRzKFNhbGFyeX4uLGRhdGE9SGl0dGVyc1t0cmFpbixdLG52bWF4PTE5KQ0KYGBgDQoNCk5vdGljZSB0aGF0IHdlIHN1YnNldCB0aGUgYEhpdHRlcnNgIGRhdGEgZnJhbWUgZGlyZWN0bHkgaW4gdGhlIGNhbGwgaW4gb3JkZXIgdG8gYWNjZXNzIG9ubHkgdGhlIHRyYWluaW5nIHN1YnNldCBvZiB0aGUgZGF0YSwgdXNpbmcgdGhlIGV4cHJlc3Npb24gYEhpdHRlcnNbdHJhaW4sXWAuIFdlIG5vdyBjb21wdXRlIHRoZSB2YWxpZGF0aW9uIHNldCBlcnJvciBmb3IgdGhlIGJlc3QgbW9kZWwgb2YgZWFjaCBtb2RlbCBzaXplLiBXZSBmaXJzdCBtYWtlIGEgbW9kZWwgbWF0cml4IGZyb20gdGhlIHRlc3QgZGF0YS4NCg0KYGBge3IgdGVzdG1hdHJpeH0NCnRlc3QubWF0PW1vZGVsLm1hdHJpeChTYWxhcnl+LixkYXRhPUhpdHRlcnMgW3Rlc3QgLF0pDQpgYGANCg0KVGhlIGBtb2RlbC5tYXRyaXgoKWAgZnVuY3Rpb24gaXMgdXNlZCBpbiBtYW55IHJlZ3Jlc3Npb24gcGFja2FnZXMgZm9yIGJ1aWxkaW5nIGFuICJYIiBtYXRyaXggZnJvbSBkYXRhLiBOb3cgd2UgcnVuIGEgbG9vcCwgYW5kIGZvciBlYWNoIHNpemUgYGlgLCB3ZSBleHRyYWN0IHRoZSBjb2VmZmljaWVudHMgZnJvbSBgcmVnZml0LmJlc3RgIGZvciB0aGUgYmVzdCBtb2RlbCBvZiB0aGF0IHNpemUsIG11bHRpcGx5IHRoZW0gaW50byB0aGUgYXBwcm9wcmlhdGUgY29sdW1ucyBvZiB0aGUgdGVzdCBtb2RlbCBtYXRyaXggdG8gZm9ybSB0aGUgcHJlZGljdGlvbnMsIGFuZCBjb21wdXRlIHRoZSB0ZXN0IE1TRS4NCg0KYGBge3IgbG9vcGl0fQ0KdmFsLmVycm9ycyA9cmVwKE5BICwxOSkNCmZvcihpIGluIDE6MTkpew0KIGNvZWZpPWNvZWYocmVnZml0LmJlc3QgLGlkPWkpDQogcHJlZD10ZXN0Lm1hdFssbmFtZXMoY29lZmkpXSUqJWNvZWZpDQogdmFsLmVycm9yc1tpXT1tZWFuKCggSGl0dGVycyRTYWxhcnlbdGVzdF0tcHJlZCleMikNCn0NCmBgYA0KDQpXZSBmaW5kIHRoYXQgdGhlIGJlc3QgbW9kZWwgaXMgdGhlIG9uZSB0aGF0IGNvbnRhaW5zIHRlbiB2YXJpYWJsZXMuDQoNCmBgYHtyIGVycm9yc30NCnZhbC5lcnJvcnMNCndoaWNoLm1pbih2YWwuZXJyb3JzKQ0KY29lZihyZWdmaXQuYmVzdCwxMCkNCmBgYA0KDQpUaGlzIHdhcyBhIGxpdHRsZSB0ZWRpb3VzLCBwYXJ0bHkgYmVjYXVzZSB0aGVyZSBpcyBubyBgcHJlZGljdCgpYCBtZXRob2QgZm9yIGByZWdzdWJzZXRzKClgLiBTaW5jZSB3ZSB3aWxsIGJlIHVzaW5nIHRoaXMgZnVuY3Rpb24gYWdhaW4sIHdlIGNhbiBjYXB0dXJlIG91ciBzdGVwcyBhYm92ZSBhbmQgd3JpdGUgb3VyIG93biBwcmVkaWN0IG1ldGhvZC4NCg0KYGBge3IgcHJlZGZ1bmN9DQpwcmVkaWN0LnJlZ3N1YnNldHM9ZnVuY3Rpb24ob2JqZWN0ICwgbmV3ZGF0YSAsaWQgLC4uLil7DQogZm9ybT1hcy5mb3JtdWxhIChvYmplY3QkY2FsbCBbWzJdXSkNCiBtYXQ9bW9kZWwubWF0cml4KGZvcm0gLG5ld2RhdGEgKQ0KIGNvZWZpPWNvZWYob2JqZWN0ICxpZD1pZCkNCiB4dmFycz1uYW1lcyhjb2VmaSkNCiBtYXRbLHh2YXJzXSUqJWNvZWZpDQp9DQpgYGANCg0KT3VyIGZ1bmN0aW9uIHByZXR0eSBtdWNoIG1pbWljcyB3aGF0IHdlIGRpZCBhYm92ZS4gVGhlIG9ubHkgY29tcGxleCBwYXJ0IGlzIGhvdyB3ZSBleHRyYWN0ZWQgdGhlIGZvcm11bGEgdXNlZCBpbiB0aGUgY2FsbCB0byBgcmVnc3Vic2V0cygpYC4gV2UgZGVtb25zdHJhdGUgaG93IHdlIHVzZSB0aGlzIGZ1bmN0aW9uIGJlbG93LCB3aGVuIHdlIGRvIGNyb3NzLXZhbGlkYXRpb24uDQoNCkZpbmFsbHksIHdlIHBlcmZvcm0gYmVzdCBzdWJzZXQgc2VsZWN0aW9uIG9uIHRoZSBmdWxsIGRhdGEgc2V0LCBhbmQgc2VsZWN0IHRoZSBiZXN0IHRlbi12YXJpYWJsZSBtb2RlbC4gSXQgaXMgaW1wb3J0YW50IHRoYXQgd2UgbWFrZSB1c2Ugb2YgdGhlIGZ1bGwNCmRhdGEgc2V0IGluIG9yZGVyIHRvIG9idGFpbiBtb3JlIGFjY3VyYXRlIGNvZWZmaWNpZW50IGVzdGltYXRlcy4gTm90ZSB0aGF0IHdlIHBlcmZvcm0gYmVzdCBzdWJzZXQgc2VsZWN0aW9uIG9uIHRoZSBmdWxsIGRhdGEgc2V0IGFuZCBzZWxlY3QgdGhlIGJlc3QgdGVudmFyaWFibGUgbW9kZWwsIHJhdGhlciB0aGFuIHNpbXBseSB1c2luZyB0aGUgdmFyaWFibGVzIHRoYXQgd2VyZSBvYnRhaW5lZCBmcm9tIHRoZSB0cmFpbmluZyBzZXQsIGJlY2F1c2UgdGhlIGJlc3QgdGVuLXZhcmlhYmxlIG1vZGVsIG9uIHRoZSBmdWxsIGRhdGEgc2V0IG1heSBkaWZmZXIgZnJvbSB0aGUgY29ycmVzcG9uZGluZyBtb2RlbCBvbiB0aGUgdHJhaW5pbmcgc2V0Lg0KDQpgYGB7cn0NCnJlZ2ZpdC5iZXN0PXJlZ3N1YnNldHMoU2FsYXJ5fi4sZGF0YT1IaXR0ZXJzLG52bWF4PTE5KQ0KY29lZihyZWdmaXQuYmVzdCAsMTApDQpgYGANCg0KSW4gZmFjdCwgd2Ugc2VlIHRoYXQgdGhlIGJlc3QgdGVuLXZhcmlhYmxlIG1vZGVsIG9uIHRoZSBmdWxsIGRhdGEgc2V0IGhhcyBhIGRpZmZlcmVudCBzZXQgb2YgdmFyaWFibGVzIHRoYW4gdGhlIGJlc3QgdGVuLXZhcmlhYmxlIG1vZGVsIG9uIHRoZSB0cmFpbmluZyBzZXQuDQoNCldlIG5vdyB0cnkgdG8gY2hvb3NlIGFtb25nIHRoZSBtb2RlbHMgb2YgZGlmZmVyZW50IHNpemVzIHVzaW5nIGNyb3NzdmFsaWRhdGlvbi4gVGhpcyBhcHByb2FjaCBpcyBzb21ld2hhdCBpbnZvbHZlZCwgYXMgd2UgbXVzdCBwZXJmb3JtIGJlc3Qgc3Vic2V0IHNlbGVjdGlvbiAqd2l0aGluIGVhY2ggb2YgdGhlIGsgdHJhaW5pbmcgc2V0cyouIERlc3BpdGUgdGhpcywgd2Ugc2VlIHRoYXQgd2l0aCBpdHMgY2xldmVyIHN1YnNldHRpbmcgc3ludGF4LCBgUmAgbWFrZXMgdGhpcyBqb2IgcXVpdGUgZWFzeS4gRmlyc3QsIHdlIGNyZWF0ZSBhIHZlY3RvciB0aGF0IGFsbG9jYXRlcyBlYWNoIG9ic2VydmF0aW9uIHRvIG9uZSBvZiAqayogPSAxMCBmb2xkcywgYW5kIHdlIGNyZWF0ZSBhIG1hdHJpeCBpbiB3aGljaCB3ZSB3aWxsIHN0b3JlIHRoZSByZXN1bHRzLg0KDQpgYGB7ciBrZm9sZH0NCms9MTANCnNldC5zZWVkKDEpDQpmb2xkcz1zYW1wbGUgKDE6ayxucm93KEhpdHRlcnMpLHJlcGxhY2U9VFJVRSkNCmN2LmVycm9ycz1tYXRyaXgoTkEsaywxOSwgZGltbmFtZXM9bGlzdChOVUxMLHBhc3RlKDE6MTkpKSkNCmBgYA0KDQpOb3cgd2Ugd3JpdGUgYSBmb3IgbG9vcCB0aGF0IHBlcmZvcm1zIGNyb3NzLXZhbGlkYXRpb24uIEluIHRoZSAqaip0aCBmb2xkLCB0aGUgZWxlbWVudHMgb2YgYGZvbGRzYCB0aGF0IGVxdWFsICpqKiBhcmUgaW4gdGhlIHRlc3Qgc2V0LCBhbmQgdGhlIHJlbWFpbmRlciBhcmUgaW4gdGhlIHRyYWluaW5nIHNldC4gV2UgbWFrZSBvdXIgcHJlZGljdGlvbnMgZm9yIGVhY2ggbW9kZWwgc2l6ZSAodXNpbmcgb3VyIG5ldyBgcHJlZGljdCgpYCBtZXRob2QpLCBjb21wdXRlIHRoZSB0ZXN0IGVycm9ycyBvbiB0aGUgYXBwcm9wcmlhdGUgc3Vic2V0LCBhbmQgc3RvcmUgdGhlbSBpbiB0aGUgYXBwcm9wcmlhdGUgc2xvdCBpbiB0aGUgbWF0cml4IGBjdi5lcnJvcnNgLg0KDQpgYGB7ciBiZXN0Zml0a2ZvbGR9DQpmb3IoaiBpbiAxOmspew0KIGJlc3QuZml0PXJlZ3N1YnNldHMgKFNhbGFyeX4uLGRhdGE9SGl0dGVyc1tmb2xkcyE9aixdLG52bWF4PTE5KQ0KIGZvcihpIGluIDE6MTkpew0KICBwcmVkPXByZWRpY3QgKGJlc3QuZml0ICxIaXR0ZXJzIFtmb2xkcyA9PWosXSxpZD1pKQ0KICBjdi5lcnJvcnNbaixpXT0gbWVhbiggKCBIaXR0ZXJzJFNhbGFyeVsgZm9sZHM9PWpdLXByZWQpXjIpDQogfQ0KfQ0KYGBgDQoNClRoaXMgaGFzIGdpdmVuIHVzIGEgMTB4MTkgbWF0cml4LCBvZiB3aGljaCB0aGUgKCppKiwgKmoqKXRoIGVsZW1lbnQgY29ycmVzcG9uZHMgdG8gdGhlIHRlc3QgTVNFIGZvciB0aGUgaXRoIGNyb3NzLXZhbGlkYXRpb24gZm9sZCBmb3IgdGhlIGJlc3QgKmoqLXZhcmlhYmxlIG1vZGVsLiBXZSB1c2UgdGhlIGBhcHBseSgpYCBmdW5jdGlvbiB0byBhdmVyYWdlIG92ZXIgdGhlIGNvbHVtbnMgb2YgdGhpcyBtYXRyaXggaW4gb3JkZXIgdG8gb2J0YWluIGEgdmVjdG9yIGZvciB3aGljaCB0aGUganRoIGVsZW1lbnQgaXMgdGhlIGNyb3NzdmFsaWRhdGlvbiBlcnJvciBmb3IgdGhlICpqKi12YXJpYWJsZSBtb2RlbC4NCg0KYGBge3J9DQptZWFuLmN2LmVycm9ycz1hcHBseShjdi5lcnJvcnMgLDIsIG1lYW4pDQptZWFuLmN2LmVycm9ycw0KcGFyKG1mcm93PWMoMSwxKSkNCnBsb3QobWVhbi5jdi5lcnJvcnMgLHR5cGU9J2InKQ0KYGBgDQoNCldlIHNlZSB0aGF0IGNyb3NzLXZhbGlkYXRpb24gc2VsZWN0cyBhbiAxMS12YXJpYWJsZSBtb2RlbC4gV2Ugbm93IHBlcmZvcm0gYmVzdCBzdWJzZXQgc2VsZWN0aW9uIG9uIHRoZSBmdWxsIGRhdGEgc2V0IGluIG9yZGVyIHRvIG9idGFpbiB0aGUgMTEtdmFyaWFibGUgbW9kZWwuDQoNCmBgYHtyfQ0KcmVnLmJlc3Q9cmVnc3Vic2V0cyAoU2FsYXJ5fi4sZGF0YT1IaXR0ZXJzLCBudm1heD0xOSkNCmNvZWYocmVnLmJlc3QgLDExKQ0KYGBgDQo=