The Validation Set Approach

library (ISLR)
set.seed (1)
train=sample (392 ,196)
lm.fit = lm(mpg~horsepower,data=Auto,subset=train)
attach (Auto)
mean((mpg-predict(lm.fit,Auto))[-train ]^2)
[1] 26.14142
lm.fit2=lm(mpg~poly(horsepower,2),data=Auto,subset=train )
mean((mpg-predict(lm.fit2,Auto))[-train ]^2)
[1] 19.82259
lm.fit3=lm(mpg~poly(horsepower,3),data=Auto,subset =train )
mean((mpg-predict(lm.fit3,Auto))[-train ]^2)
[1] 19.78252
set.seed (2)
train=sample (392 ,196)
lm.fit =lm(mpg~horsepower,subset =train)
mean((mpg -predict (lm.fit ,Auto))[-train ]^2)
[1] 23.29559
lm.fit2=lm(mpg~poly(horsepower,2) ,data=Auto ,subset =train )
mean((mpg-predict(lm.fit2 ,Auto))[-train ]^2)
[1] 18.90124
lm.fit3=lm(mpg~poly(horsepower,3) ,data=Auto ,subset =train )
mean((mpg -predict (lm.fit3 ,Auto))[-train ]^2)
[1] 19.2574

Leave-One-Out Cross-Validation

glm.fit=glm(mpg~horsepower,data=Auto)
coef(glm.fit)
(Intercept)  horsepower 
 39.9358610  -0.1578447 
lm.fit =lm(mpg~horsepower,data=Auto)
coef(lm.fit)
(Intercept)  horsepower 
 39.9358610  -0.1578447 
library (boot)
glm.fit=glm(mpg~horsepower ,data=Auto)
cv.err =cv.glm(Auto,glm.fit)
cv.err$delta
[1] 24.23151 24.23114
cv.error=rep (0,5)
for (i in 1:5){
  glm.fit=glm(mpg~poly(horsepower, i), data = Auto)
  cv.error[i]=cv.glm (Auto, glm.fit)$delta [1]
}
cv.error
[1] 24.23151 19.24821 19.33498 19.42443 19.03321

k-Fold Cross-Validation

set.seed (17)
cv.error.10= rep(0,10)
for (i in 1:10) {
  glm.fit=glm(mpg~poly(horsepower, i),data=Auto)
  cv.error.10[i]=cv.glm (Auto, glm.fit, K=10)$delta[1]
}
cv.error.10
 [1] 24.20520 19.18924 19.30662 19.33799 18.87911 19.02103 18.89609 19.71201 18.95140 19.50196

The Bootstrap

Estimating the Accuracy of a Statistic of Interest

alpha.fn=function (data ,index){
  X=data$X [index]
  Y=data$Y [index]
  return ((var(Y)-cov (X,Y))/(var(X)+var(Y) -2* cov(X,Y)))
}
alpha.fn(Portfolio,1:100)
[1] 0.5758321
set.seed (1)
alpha.fn(Portfolio,sample(100,100,replace = T))
[1] 0.5963833
boot(Portfolio,alpha.fn,R=1000)

ORDINARY NONPARAMETRIC BOOTSTRAP


Call:
boot(data = Portfolio, statistic = alpha.fn, R = 1000)


Bootstrap Statistics :
     original        bias    std. error
t1* 0.5758321 -7.315422e-05  0.08861826

Estimating the Accuracy of a Linear Regression Model

boot.fn=function (data ,index )
return (coef(lm(mpg~horsepower,data=data ,subset =index)))
boot.fn(Auto ,1:392)
(Intercept)  horsepower 
 39.9358610  -0.1578447 
set.seed (1)
boot.fn(Auto,sample(392,392, replace = T))
(Intercept)  horsepower 
 38.7387134  -0.1481952 
boot.fn(Auto,sample(392,392, replace = T))
(Intercept)  horsepower 
 40.0383086  -0.1596104 
boot(Auto ,boot.fn ,1000)

ORDINARY NONPARAMETRIC BOOTSTRAP


Call:
boot(data = Auto, statistic = boot.fn, R = 1000)


Bootstrap Statistics :
      original      bias    std. error
t1* 39.9358610  0.02972191 0.860007896
t2* -0.1578447 -0.00030823 0.007404467
summary (lm(mpg~horsepower ,data=Auto))$coef
              Estimate  Std. Error   t value      Pr(>|t|)
(Intercept) 39.9358610 0.717498656  55.65984 1.220362e-187
horsepower  -0.1578447 0.006445501 -24.48914  7.031989e-81
boot.fn=function (data ,index )
coefficients(lm(mpg~horsepower+I(horsepower^2), data=data, subset =index))
set.seed (1)
boot(Auto, boot.fn ,1000)

ORDINARY NONPARAMETRIC BOOTSTRAP


Call:
boot(data = Auto, statistic = boot.fn, R = 1000)


Bootstrap Statistics :
        original        bias     std. error
t1* 56.900099702  6.098115e-03 2.0944855842
t2* -0.466189630 -1.777108e-04 0.0334123802
t3*  0.001230536  1.324315e-06 0.0001208339
summary (lm(mpg~horsepower+I(horsepower^2) ,data=Auto))$coef
                    Estimate   Std. Error   t value      Pr(>|t|)
(Intercept)     56.900099702 1.8004268063  31.60367 1.740911e-109
horsepower      -0.466189630 0.0311246171 -14.97816  2.289429e-40
I(horsepower^2)  0.001230536 0.0001220759  10.08009  2.196340e-21
LS0tDQp0aXRsZTogIkxhYm9yYXRvcmlvIENhcO10dWxvIDUiDQpzdWJ0aXRsZTogIkFsZWphbmRyYSBDZXJtZfFvIg0Kb3V0cHV0OiBodG1sX25vdGVib29rDQotLS0NCg0KDQojIyNUaGUgVmFsaWRhdGlvbiBTZXQgQXBwcm9hY2gNCg0KYGBge3J9DQpsaWJyYXJ5IChJU0xSKQ0Kc2V0LnNlZWQgKDEpDQp0cmFpbj1zYW1wbGUgKDM5MiAsMTk2KQ0KYGBgDQoNCmBgYHtyfQ0KbG0uZml0ID0gbG0obXBnPz8/aG9yc2Vwb3dlcixkYXRhPUF1dG8sc3Vic2V0PXRyYWluKQ0KYXR0YWNoIChBdXRvKQ0KbWVhbigobXBnLXByZWRpY3QobG0uZml0LEF1dG8pKVstdHJhaW4gXV4yKQ0KYGBgDQoNCmBgYHtyfQ0KbG0uZml0Mj1sbShtcGc/Pz9wb2x5KGhvcnNlcG93ZXIsMiksZGF0YT1BdXRvLHN1YnNldD10cmFpbiApDQptZWFuKChtcGctcHJlZGljdChsbS5maXQyLEF1dG8pKVstdHJhaW4gXV4yKQ0KYGBgDQoNCmBgYHtyfQ0KbG0uZml0Mz1sbShtcGc/Pz9wb2x5KGhvcnNlcG93ZXIsMyksZGF0YT1BdXRvLHN1YnNldCA9dHJhaW4gKQ0KbWVhbigobXBnLXByZWRpY3QobG0uZml0MyxBdXRvKSlbLXRyYWluIF1eMikNCmBgYA0KDQpgYGB7cn0NCnNldC5zZWVkICgyKQ0KdHJhaW49c2FtcGxlICgzOTIgLDE5NikNCmxtLmZpdCA9bG0obXBnPz8/aG9yc2Vwb3dlcixzdWJzZXQgPXRyYWluKQ0KbWVhbigobXBnLXByZWRpY3QobG0uZml0ICxBdXRvKSlbLXRyYWluIF1eMikNCmBgYA0KDQpgYGB7cn0NCmxtLmZpdDI9bG0obXBnPz8/cG9seShob3JzZXBvd2VyLDIpICxkYXRhPUF1dG8gLHN1YnNldCA9dHJhaW4gKQ0KbWVhbigobXBnLXByZWRpY3QobG0uZml0MiAsQXV0bykpWy10cmFpbiBdXjIpDQpgYGANCg0KYGBge3J9DQpsbS5maXQzPWxtKG1wZz8/P3BvbHkoaG9yc2Vwb3dlciwzKSAsZGF0YT1BdXRvICxzdWJzZXQgPXRyYWluICkNCm1lYW4oKG1wZyAtcHJlZGljdCAobG0uZml0MyAsQXV0bykpWy10cmFpbiBdXjIpDQpgYGANCg0KIyMjTGVhdmUtT25lLU91dCBDcm9zcy1WYWxpZGF0aW9uDQoNCmBgYHtyfQ0KZ2xtLmZpdD1nbG0obXBnPz8/aG9yc2Vwb3dlcixkYXRhPUF1dG8pDQpjb2VmKGdsbS5maXQpDQpgYGANCg0KYGBge3J9DQpsbS5maXQgPWxtKG1wZz8/P2hvcnNlcG93ZXIsZGF0YT1BdXRvKQ0KY29lZihsbS5maXQpDQpgYGANCg0KYGBge3J9DQpsaWJyYXJ5IChib290KQ0KZ2xtLmZpdD1nbG0obXBnPz8/aG9yc2Vwb3dlciAsZGF0YT1BdXRvKQ0KY3YuZXJyID1jdi5nbG0oQXV0byxnbG0uZml0KQ0KY3YuZXJyJGRlbHRhDQpgYGANCg0KYGBge3J9DQpjdi5lcnJvcj1yZXAgKDAsNSkNCmZvciAoaSBpbiAxOjUpew0KICBnbG0uZml0PWdsbShtcGc/Pz9wb2x5KGhvcnNlcG93ZXIsIGkpLCBkYXRhID0gQXV0bykNCiAgY3YuZXJyb3JbaV09Y3YuZ2xtIChBdXRvLCBnbG0uZml0KSRkZWx0YSBbMV0NCn0NCmN2LmVycm9yDQpgYGANCg0KIyMjay1Gb2xkIENyb3NzLVZhbGlkYXRpb24NCg0KYGBge3J9DQpzZXQuc2VlZCAoMTcpDQpjdi5lcnJvci4xMD0gcmVwKDAsMTApDQpmb3IgKGkgaW4gMToxMCkgew0KICBnbG0uZml0PWdsbShtcGc/Pz9wb2x5KGhvcnNlcG93ZXIsIGkpLGRhdGE9QXV0bykNCiAgY3YuZXJyb3IuMTBbaV09Y3YuZ2xtIChBdXRvLCBnbG0uZml0LCBLPTEwKSRkZWx0YVsxXQ0KfQ0KY3YuZXJyb3IuMTANCmBgYA0KDQojIyNUaGUgQm9vdHN0cmFwDQoNCiMjIyNFc3RpbWF0aW5nIHRoZSBBY2N1cmFjeSBvZiBhIFN0YXRpc3RpYyBvZiBJbnRlcmVzdA0KDQpgYGB7cn0NCmFscGhhLmZuPWZ1bmN0aW9uIChkYXRhICxpbmRleCl7DQogIFg9ZGF0YSRYIFtpbmRleF0NCiAgWT1kYXRhJFkgW2luZGV4XQ0KICByZXR1cm4gKCh2YXIoWSktY292IChYLFkpKS8odmFyKFgpK3ZhcihZKSAtMiogY292KFgsWSkpKQ0KfQ0KYGBgDQoNCmBgYHtyfQ0KYWxwaGEuZm4oUG9ydGZvbGlvLDE6MTAwKQ0KYGBgDQoNCmBgYHtyfQ0Kc2V0LnNlZWQgKDEpDQphbHBoYS5mbihQb3J0Zm9saW8sc2FtcGxlKDEwMCwxMDAscmVwbGFjZSA9IFQpKQ0KYGBgDQoNCmBgYHtyfQ0KYm9vdChQb3J0Zm9saW8sYWxwaGEuZm4sUj0xMDAwKQ0KYGBgDQoNCiMjIyNFc3RpbWF0aW5nIHRoZSBBY2N1cmFjeSBvZiBhIExpbmVhciBSZWdyZXNzaW9uIE1vZGVsDQoNCmBgYHtyfQ0KYm9vdC5mbj1mdW5jdGlvbiAoZGF0YSAsaW5kZXggKQ0KcmV0dXJuIChjb2VmKGxtKG1wZz8/P2hvcnNlcG93ZXIsZGF0YT1kYXRhICxzdWJzZXQgPWluZGV4KSkpDQpib290LmZuKEF1dG8gLDE6MzkyKQ0KYGBgDQoNCmBgYHtyfQ0Kc2V0LnNlZWQgKDEpDQpib290LmZuKEF1dG8sc2FtcGxlKDM5MiwzOTIsIHJlcGxhY2UgPSBUKSkNCmBgYA0KDQpgYGB7cn0NCmJvb3QuZm4oQXV0byxzYW1wbGUoMzkyLDM5MiwgcmVwbGFjZSA9IFQpKQ0KYGBgDQoNCmBgYHtyfQ0KYm9vdChBdXRvICxib290LmZuICwxMDAwKQ0KYGBgDQoNCmBgYHtyfQ0Kc3VtbWFyeSAobG0obXBnPz8/aG9yc2Vwb3dlciAsZGF0YT1BdXRvKSkkY29lZg0KYGBgDQoNCmBgYHtyfQ0KYm9vdC5mbj1mdW5jdGlvbiAoZGF0YSAsaW5kZXggKQ0KY29lZmZpY2llbnRzKGxtKG1wZz8/P2hvcnNlcG93ZXIrSShob3JzZXBvd2VyXjIpLCBkYXRhPWRhdGEsIHN1YnNldCA9aW5kZXgpKQ0Kc2V0LnNlZWQgKDEpDQpib290KEF1dG8sIGJvb3QuZm4gLDEwMDApDQpgYGANCg0KYGBge3J9DQpzdW1tYXJ5IChsbShtcGc/Pz9ob3JzZXBvd2VyK0koaG9yc2Vwb3dlcl4yKSAsZGF0YT1BdXRvKSkkY29lZg0KYGBgDQoNCg==