Dades de les principals lligues de beisbol de les temporades 1986 i 1987.
Un data frame amb 322 observacions de jugadors de les principals lligues sobre les 20 variables següents.
AtBat: Número de vegades al bat en 1986Hits: Número de bateades en 1986HmRun: Número de home runs en 1986Runs Número de carreres en 1986RBI: Número de carreres batejades en 1986Walks: Número de walks en 1986Years: Número d'anys en les lligues principalsCAtBat: Número de vegades al bat durant la seva carreraCHits: Número de bateades durant la seva carreraCHmRun: Número de home runs durant la seva carreraCRuns: Número de carreres durant la seva carreraCRBI: Número de carreres batudes durant la seva carreraCWalks: Número de walks durant la seva carreraLeague: Factor amb nivells A i N que indica la lliga del jugador a finals del 1986Division: Factor amb nivells E i W que indica la divisió del jugador a finals del 1986PutOuts: Número de put outs en 1986Assists: Número de assistències en 1986Errors: Número de errors en 1986Salary: Salari anual en milers d dolars en la primera jornada inaugural de l'any 1987NewLeague: Factor amb nivells A i N que indica la lliga del jugador a principis del 1987Aquest conjunt de dades s’ha extret de la biblioteca StatLib que es manté a la Universitat Carnegie Mellon. Això forma part de les dades que es van utilitzar a la sessió de pòsters de la secció de gràfics ASA de 1988. Les dades salarials eren originàriament de Sports Illustrated, el 20 d’abril de 1987. Les estadístiques de 1986 i de carrera es van obtenir a partir de la ‘Baseball Encyclopedia Update 1987’ publicat per Collier Books, Macmillan Publishing Company, Nova York.
James, G., Witten, D., Hastie, T. i Tibshirani, R. (2013) An Introduction to Statistical Learning with applications in R, www.StatLearning.com, Springer-Verlag, Nova York.
Predir el salari d'un jugador de beisbol amb les variables de la base de dades.
Comencem descarregant el paquet ISLR que inclou el conjunt de dades Hitters.
#install.packages("ISLR",dependencies=TRUE,repos="https://cloud.r-project.org")
require(ISLR)
#fix(Hitters)
str(Hitters)
head(Hitters)
| AtBat | Hits | HmRun | Runs | RBI | Walks | Years | CAtBat | CHits | CHmRun | CRuns | CRBI | CWalks | League | Division | PutOuts | Assists | Errors | Salary | NewLeague | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| <int> | <int> | <int> | <int> | <int> | <int> | <int> | <int> | <int> | <int> | <int> | <int> | <int> | <fct> | <fct> | <int> | <int> | <int> | <dbl> | <fct> | |
| -Andy Allanson | 293 | 66 | 1 | 30 | 29 | 14 | 1 | 293 | 66 | 1 | 30 | 29 | 14 | A | E | 446 | 33 | 20 | NA | A |
| -Alan Ashby | 315 | 81 | 7 | 24 | 38 | 39 | 14 | 3449 | 835 | 69 | 321 | 414 | 375 | N | W | 632 | 43 | 10 | 475.0 | N |
| -Alvin Davis | 479 | 130 | 18 | 66 | 72 | 76 | 3 | 1624 | 457 | 63 | 224 | 266 | 263 | A | W | 880 | 82 | 14 | 480.0 | A |
| -Andre Dawson | 496 | 141 | 20 | 65 | 78 | 37 | 11 | 5628 | 1575 | 225 | 828 | 838 | 354 | N | E | 200 | 11 | 3 | 500.0 | N |
| -Andres Galarraga | 321 | 87 | 10 | 39 | 42 | 30 | 2 | 396 | 101 | 12 | 48 | 46 | 33 | N | E | 805 | 40 | 4 | 91.5 | N |
| -Alfredo Griffin | 594 | 169 | 4 | 74 | 51 | 35 | 11 | 4408 | 1133 | 19 | 501 | 336 | 194 | A | W | 282 | 421 | 25 | 750.0 | A |
Abans de tot, hem de veure si falten valors d'alguna variable per tal d'ometre aquestes dades buides.
Utilitzarem la funció is.na() que indica les observacions buides i la funció sum() que ens dona el nombre d'elements que falten.
Com hi ha jugadors que no tenen la dada del Salary (variable aleatòria resposta), utilitzarem la funció na.omit() per eliminar les files on falti aquest valor.
dim(Hitters)
sum(is.na(Hitters$Salary))
Hitters=na.omit(Hitters)
dim(Hitters)
sum(is.na(Hitters))
A continuació apliquem el mètode de regressió lineal de Mínims Quadrats Ordinaris (MQO), on Salary serà la variable aleatòria resposta, i totes les altres formaran la matriu X de predictors.
Hitters.lm.1<-lm(Salary~., data=Hitters)
summary(Hitters.lm.1)
Call:
lm(formula = Salary ~ ., data = Hitters)
Residuals:
Min 1Q Median 3Q Max
-907.62 -178.35 -31.11 139.09 1877.04
Coefficients:
Estimate Std. Error t value Pr(>|t|)
(Intercept) 163.10359 90.77854 1.797 0.073622 .
AtBat -1.97987 0.63398 -3.123 0.002008 **
Hits 7.50077 2.37753 3.155 0.001808 **
HmRun 4.33088 6.20145 0.698 0.485616
Runs -2.37621 2.98076 -0.797 0.426122
RBI -1.04496 2.60088 -0.402 0.688204
Walks 6.23129 1.82850 3.408 0.000766 ***
Years -3.48905 12.41219 -0.281 0.778874
CAtBat -0.17134 0.13524 -1.267 0.206380
CHits 0.13399 0.67455 0.199 0.842713
CHmRun -0.17286 1.61724 -0.107 0.914967
CRuns 1.45430 0.75046 1.938 0.053795 .
CRBI 0.80771 0.69262 1.166 0.244691
CWalks -0.81157 0.32808 -2.474 0.014057 *
LeagueN 62.59942 79.26140 0.790 0.430424
DivisionW -116.84925 40.36695 -2.895 0.004141 **
PutOuts 0.28189 0.07744 3.640 0.000333 ***
Assists 0.37107 0.22120 1.678 0.094723 .
Errors -3.36076 4.39163 -0.765 0.444857
NewLeagueN -24.76233 79.00263 -0.313 0.754218
---
Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
Residual standard error: 315.6 on 243 degrees of freedom
Multiple R-squared: 0.5461, Adjusted R-squared: 0.5106
F-statistic: 15.39 on 19 and 243 DF, p-value: < 2.2e-16
Abans de donar aquest model per bo, ens hem d'assegurar que els predictors no presenten un problema de multicol·linealitat. Primer vegem la matriu de correlacions de forma númerica i de forma gràfica:
x<-model.matrix(Salary~.,Hitters)[,-1]
round(cor(x),2)->mat_cor
mat_cor
| AtBat | Hits | HmRun | Runs | RBI | Walks | Years | CAtBat | CHits | CHmRun | CRuns | CRBI | CWalks | LeagueN | DivisionW | PutOuts | Assists | Errors | NewLeagueN | |
|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|---|
| AtBat | 1.00 | 0.96 | 0.56 | 0.90 | 0.80 | 0.62 | 0.01 | 0.21 | 0.23 | 0.21 | 0.24 | 0.22 | 0.13 | -0.15 | -0.06 | 0.31 | 0.34 | 0.33 | -0.09 |
| Hits | 0.96 | 1.00 | 0.53 | 0.91 | 0.79 | 0.59 | 0.02 | 0.21 | 0.24 | 0.19 | 0.24 | 0.22 | 0.12 | -0.15 | -0.08 | 0.30 | 0.30 | 0.28 | -0.09 |
| HmRun | 0.56 | 0.53 | 1.00 | 0.63 | 0.85 | 0.44 | 0.11 | 0.22 | 0.22 | 0.49 | 0.26 | 0.35 | 0.23 | -0.22 | -0.03 | 0.25 | -0.16 | -0.01 | -0.20 |
| Runs | 0.90 | 0.91 | 0.63 | 1.00 | 0.78 | 0.70 | -0.01 | 0.17 | 0.19 | 0.23 | 0.24 | 0.20 | 0.16 | -0.21 | -0.11 | 0.27 | 0.18 | 0.19 | -0.15 |
| RBI | 0.80 | 0.79 | 0.85 | 0.78 | 1.00 | 0.57 | 0.13 | 0.28 | 0.29 | 0.44 | 0.31 | 0.39 | 0.23 | -0.19 | -0.09 | 0.31 | 0.06 | 0.15 | -0.14 |
| Walks | 0.62 | 0.59 | 0.44 | 0.70 | 0.57 | 1.00 | 0.13 | 0.27 | 0.27 | 0.35 | 0.33 | 0.31 | 0.43 | -0.07 | -0.07 | 0.28 | 0.10 | 0.08 | -0.03 |
| Years | 0.01 | 0.02 | 0.11 | -0.01 | 0.13 | 0.13 | 1.00 | 0.92 | 0.90 | 0.72 | 0.88 | 0.86 | 0.84 | -0.03 | -0.02 | -0.02 | -0.09 | -0.16 | -0.02 |
| CAtBat | 0.21 | 0.21 | 0.22 | 0.17 | 0.28 | 0.27 | 0.92 | 1.00 | 1.00 | 0.80 | 0.98 | 0.95 | 0.91 | -0.02 | -0.02 | 0.05 | -0.01 | -0.07 | 0.00 |
| CHits | 0.23 | 0.24 | 0.22 | 0.19 | 0.29 | 0.27 | 0.90 | 1.00 | 1.00 | 0.79 | 0.98 | 0.95 | 0.89 | -0.02 | -0.02 | 0.07 | -0.01 | -0.07 | 0.00 |
| CHmRun | 0.21 | 0.19 | 0.49 | 0.23 | 0.44 | 0.35 | 0.72 | 0.80 | 0.79 | 1.00 | 0.83 | 0.93 | 0.81 | -0.11 | -0.03 | 0.09 | -0.19 | -0.17 | -0.10 |
| CRuns | 0.24 | 0.24 | 0.26 | 0.24 | 0.31 | 0.33 | 0.88 | 0.98 | 0.98 | 0.83 | 1.00 | 0.95 | 0.93 | -0.05 | -0.05 | 0.06 | -0.04 | -0.09 | -0.03 |
| CRBI | 0.22 | 0.22 | 0.35 | 0.20 | 0.39 | 0.31 | 0.86 | 0.95 | 0.95 | 0.93 | 0.95 | 1.00 | 0.89 | -0.05 | -0.02 | 0.10 | -0.10 | -0.12 | -0.04 |
| CWalks | 0.13 | 0.12 | 0.23 | 0.16 | 0.23 | 0.43 | 0.84 | 0.91 | 0.89 | 0.81 | 0.93 | 0.89 | 1.00 | -0.03 | -0.05 | 0.06 | -0.07 | -0.13 | -0.03 |
| LeagueN | -0.15 | -0.15 | -0.22 | -0.21 | -0.19 | -0.07 | -0.03 | -0.02 | -0.02 | -0.11 | -0.05 | -0.05 | -0.03 | 1.00 | 0.00 | 0.04 | 0.05 | 0.09 | 0.86 |
| DivisionW | -0.06 | -0.08 | -0.03 | -0.11 | -0.09 | -0.07 | -0.02 | -0.02 | -0.02 | -0.03 | -0.05 | -0.02 | -0.05 | 0.00 | 1.00 | -0.03 | -0.02 | 0.00 | 0.00 |
| PutOuts | 0.31 | 0.30 | 0.25 | 0.27 | 0.31 | 0.28 | -0.02 | 0.05 | 0.07 | 0.09 | 0.06 | 0.10 | 0.06 | 0.04 | -0.03 | 1.00 | -0.04 | 0.08 | 0.06 |
| Assists | 0.34 | 0.30 | -0.16 | 0.18 | 0.06 | 0.10 | -0.09 | -0.01 | -0.01 | -0.19 | -0.04 | -0.10 | -0.07 | 0.05 | -0.02 | -0.04 | 1.00 | 0.70 | 0.04 |
| Errors | 0.33 | 0.28 | -0.01 | 0.19 | 0.15 | 0.08 | -0.16 | -0.07 | -0.07 | -0.17 | -0.09 | -0.12 | -0.13 | 0.09 | 0.00 | 0.08 | 0.70 | 1.00 | 0.06 |
| NewLeagueN | -0.09 | -0.09 | -0.20 | -0.15 | -0.14 | -0.03 | -0.02 | 0.00 | 0.00 | -0.10 | -0.03 | -0.04 | -0.03 | 0.86 | 0.00 | 0.06 | 0.04 | 0.06 | 1.00 |
#install.packages("corrplot",dependencies=TRUE,repos="https://cloud.r-project.org")
require(corrplot)
options(repr.plot.width=8,repr.plot.height=8)
corrplot(mat_cor, type="upper", order="hclust", tl.col="black", tl.srt=45)
Veiem que alguns coeficients de correlació són bastant propers a 1, el que indica que hi ha relacions entre els predictors.
Calcularem el FIV, funció que es troba al paquet car:
#install.packages("car",dependencies=TRUE,repos="https://cloud.r-project.org")
require(car)
round(vif(Hitters.lm.1),2)
Com podem observar, hi ha diversos valors del FIV que superen el valor 1, per tant reafirmem que tenim un gran problema de multicol·linealitat.
Per últim calculem el número de condició:
x<-model.matrix(Salary~.,Hitters)
round(kappa(x),2)
Com podem veure, el número de condició és molt elevat.
Com que la restricció del ridge/lasso/Elastic Net tracta tots els coeficients per igual, normalment té sentit que tots els elements de X estiguin en les mateixes unitats. Si no, sense cap pèrdua de generalitat, centralitzarem i estandarditzarem els predictors per tal que cadascuna de les columnes de X tingui mitjana 0 i variància 1.
x<-x[,-1]
xm<-apply(x,2,mean)
xc<-sweep(x,2,xm,"-")
round(max(abs(apply(xc,2,mean))),6)
xs<-apply(xc,2,sd)
x0<-sweep(xc,2,xs,"/")
str(x0)
num [1:263, 1:19] -0.602 0.512 0.627 -0.561 1.292 ... - attr(*, "dimnames")=List of 2 ..$ : chr [1:263] "-Alan Ashby" "-Alvin Davis" "-Andre Dawson" "-Andres Galarraga" ... ..$ : chr [1:19] "AtBat" "Hits" "HmRun" "Runs" ...
Arribem a la conclusió que com hi ha multicol·linealitat entre les variables del model no podem aplicar MQO. Per tant, utilitzarem la regressió Ridge per estimar els coeficients del model.
Preparem les dades en forma de matriu per poder utilitzar la funció glmnet, un paquet que inclou les regressions Ridge, Lasso i Elastic Net que farem servir.
x<-x0
y<-Hitters$Salary
#install.packages("glmnet",dependencies=TRUE,repos="https://cloud.r-project.org")
require(glmnet)
Primer definim un ventall de possible valors de $\lambda$:
grid<-exp(seq(10,-2,length=100))
Per obtenir el camí de solucions dels coeficients en funció de $\lambda$ apliquem la funció glmnet() a les dades utilitzant que:
alpha=0 correspon a la regressió Ridge
alpha=1 correspon a la regressió Lasso
Hitters.ridge.01<-glmnet(x,y,alpha=0,lambda=grid)
Ara utilitzem la funció plotper realitzar el gràfic que ens permet veure l'estimació dels coeficientes del model ajustat respecte a:
options(repr.plot.width=20,repr.plot.height=7)
old.par<-par(mfrow=c(1,3))
plot(Hitters.ridge.01,xvar="norm")
abline(h=0,lty=2,col='black')
title('Ridge Regression\n')
plot(Hitters.ridge.01,xvar="lambda")
abline(h=0,lty=2,col='black')
title('Ridge Regression\n')
plot(Hitters.ridge.01,xvar="dev")
abline(h=0,lty=2,col='black')
title('Ridge Regression\n')
Per a calcular el valor de $\lambda$ òptim, primer hem d'establir una "llavor aleatòria" perquè els resultats obtinguts puguin ser reproduïbles.
Després apliquem la funció cv.glmnet() per obtenir el valor de $\lambda$ que minimitza l'error de predicció, mitjançant la validació encreuada.
set.seed(24025)
Hitters.ridge.01.cv<-cv.glmnet(x,y,alpha=0,lambda=grid)
Tornem a utilitzar la funció plot per veure gràficament els resultats de la validació encreuada. Podem veure dues marques:
bestlam.ridge1<-Hitters.ridge.01.cv$lambda.min
lam1se.ridge1<-Hitters.ridge.01.cv$lambda.1se
options(repr.plot.width=7, repr.plot.height=7)
plot(Hitters.ridge.01.cv)
abline(v=log(bestlam.ridge1),lwd=3,col="cyan")
round(log(bestlam.ridge1),2)
round(log(lam1se.ridge1),2)
Finalment utilitzem la funció predict() per reajustar els coeficients utilitzant el valor de la $\lambda$ resultant de la validació encreuada.
# We extract now the regression coefficients with the 'predict' function
coeff.01.ridge<-as.numeric(predict(Hitters.ridge.01,s=bestlam.ridge1,type="coefficients"))
round(coeff.01.ridge,2)
Com podem veure, els coeficients han quedat restringits cap a zero i a canvi d'afegir biaix hem reduït la variància. Tanmateix cap dels coeficients és igual a zero, ja que la regressió Ridge no fa selecció de variables.
Repetim el mateix procediment, però en aquest cas, estimant el model mitjançant la regressió Lasso.
Tornem a definim un ventall de possible valors de $\lambda$:
grid<-exp(seq(6,-2,length=100))
#str(grid)
Per obtenir el camí de solucions dels coeficients en funció de $\lambda$ apliquem la funció glmnet() a les dades utilitzant que alpha=1 correspon a la regressió Lasso.
Hitters.lasso.01<-glmnet(x,y,alpha=1,lambda=grid)
Ara utilitzem la funció plotper realitzar el gràfic que ens permet veure l'estimació dels coeficientes del model ajustat respecte a:
options(repr.plot.width=20,repr.plot.height=7)
old.par<-par(mfrow=c(1,3))
plot(Hitters.lasso.01,xvar="norm")
abline(h=0,lty=2,col='black')
title('Lasso Regression\n')
plot(Hitters.lasso.01,xvar="lambda")
abline(h=0,lty=2,col='black')
title('Lasso Regression\n')
plot(Hitters.lasso.01,xvar="dev")
abline(h=0,lty=2,col='black')
title('Lasso Regression\n')
Per a calcular el valor de $\lambda$ òptim, tornem a establir la mateixa "llavor aleatòria" perquè els resultats obtinguts puguin ser reproduïbles.
Després apliquem la funció cv.glmnet() per obtenir el valor de $\lambda$ que minimitza l'error de predicció, mitjançant la validació encreuada.
set.seed(24025)
Hitters.lasso.01.cv<-cv.glmnet(x,y,alpha=1,lambda=grid)
Tornem a utilitzar la funció plot per veure gràficament els resultats de la validació encreuada. Podem veure dues marques:
bestlam.lasso1<-Hitters.lasso.01.cv$lambda.min
lam1se.lasso1<-Hitters.lasso.01.cv$lambda.1se
options(repr.plot.width=7, repr.plot.height=7)
plot(Hitters.lasso.01.cv)
abline(v=log(bestlam.lasso1),lwd=3,col="cyan")
round(log(bestlam.lasso1),2)
round(log(lam1se.lasso1),2)
Finalment utilitzem la funció predict() per reajustar els coeficients utilitzant el valor de la $\lambda$ resultant de la validació encreuada.
# We extract now the regression coefficients with the 'predict' function
coeff.01.lasso<-as.numeric(predict(Hitters.lasso.01,s=bestlam.lasso1,type="coefficients"))
round(coeff.01.lasso,2)
Veiem que 6 dels coeficients de la regressió són exactament iguals a zero, per tant les variables asssociades no estaran en el model.
Hem comprobat que el lasso realitza selecció de variables.
El procediment Elastic Net pren valors de alpha entre $0$ i $1$. Anem a veure com canvia el model per a alphes diferents.
Definim un ventall de possible valors de $\lambda$:
grid<-exp(seq(10,-15,length=100))
Per obtenir el camí de solucions dels coeficients en funció de $\lambda$ apliquem la funció glmnet() a les dades utilitzant:
alpha=0.001
alpha=0.3
alpha=0.5
alpha=0.999
Hitters.net.01<-glmnet(x,y,alpha=0.001,lambda=grid)
Hitters.net.02<-glmnet(x,y,alpha=0.3,lambda=grid)
Hitters.net.03<-glmnet(x,y,alpha=0.5,lambda=grid)
Hitters.net.04<-glmnet(x,y,alpha=0.999,lambda=grid)
Ara utilitzem la funció plotper realitzar el gràfic que ens permet veure l'estimació dels coeficientes del model ajustat per a les diferents alpha:
options(repr.plot.width=20,repr.plot.height=7)
old.par<-par(mfrow=c(1,4))
plot(Hitters.net.01,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.001\n')
plot(Hitters.net.02,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.3\n')
plot(Hitters.net.03,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.5\n')
plot(Hitters.net.04,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.999\n')
Com podem observar, la primera gràfica (alpha=0.001) és molt semblant al camí de les solucions que proporciona la regressió Ridge, ja que el coeficient alpha està molt a prop de 0. Per altra banda, l'última gràfica (alpha=0.999) és quasi idèntica al camí de les solucions que ens dona la regressió Lasso, perquè el coeficient alpha és quasi 1.
Tornem a establir la mateixa "llavor aleatòria" per a que els resultats obtinguts siguin reproduïbles.
Després apliquem la funció cv.glmnet() per obtenir el valor de $\lambda$ que minimitza l'error de predicció, mitjançant la validació encreuada, aplicada a cada model.
set.seed(23025)
Hitters.net.01.cv<-cv.glmnet(x,y,alpha=0.001,lambda=grid)
Hitters.net.02.cv<-cv.glmnet(x,y,alpha=0.3,lambda=grid)
Hitters.net.03.cv<-cv.glmnet(x,y,alpha=0.5,lambda=grid)
Hitters.net.04.cv<-cv.glmnet(x,y,alpha=0.999,lambda=grid)
Tornem a utilitzar la funció plot per veure gràficament els resultats de la validació encreuada. Podem veure dues marques:
options(repr.plot.width=15,repr.plot.height=15)
old.par<-par(mfrow=c(2,2))
bestlam.net1<-Hitters.net.01.cv$lambda.min
lam1se.net1<-Hitters.net.01.cv$lambda.1se
plot(Hitters.net.01.cv)
abline(v=log(bestlam.net1),lwd=3,col="cyan")
round(log(bestlam.net1),2)
bestlam.net2<-Hitters.net.02.cv$lambda.min
lam1se.net2<-Hitters.net.02.cv$lambda.1se
plot(Hitters.net.02.cv)
abline(v=log(bestlam.net2),lwd=3,col="cyan")
round(log(bestlam.net2),2)
bestlam.net3<-Hitters.net.03.cv$lambda.min
lam1se.net3<-Hitters.net.03.cv$lambda.1se
plot(Hitters.net.03.cv)
abline(v=log(bestlam.net3),lwd=3,col="cyan")
round(log(bestlam.net3),2)
bestlam.net4<-Hitters.net.04.cv$lambda.min
lam1se.net4<-Hitters.net.04.cv$lambda.1se
plot(Hitters.net.04.cv)
abline(v=log(bestlam.net4),lwd=3,col="cyan")
round(log(bestlam.net4),2)
Finalment utilitzem la funció predict() per reajustar els coeficients utilitzant el valor de la $\lambda$ resultant de la validació encreuada.
# We extract now the regression coefficients with the 'predict' function
coeff.01.net<-as.numeric(predict(Hitters.net.01,s=bestlam.net1,type="coefficients"))
coeff.02.net<-as.numeric(predict(Hitters.net.02,s=bestlam.net2,type="coefficients"))
coeff.03.net<-as.numeric(predict(Hitters.net.03,s=bestlam.net3,type="coefficients"))
coeff.04.net<-as.numeric(predict(Hitters.net.04,s=bestlam.net4,type="coefficients"))
round(coeff.01.net,2)
round(coeff.02.net,2)
round(coeff.03.net,2)
round(coeff.04.net,2)
Similars als coeficients de la regressió lasso, amb alguns coeficients nuls, que resolen les limitacions del lasso.
A continuació podem veure els diferents gràfics que ens permeten veure l'estimació dels coeficients del model ajustat pels diferents alpha, incloent-hi les regressions Ridge i Lasso.
options(repr.plot.width=14,repr.plot.height=10)
old.par<-par(mfrow=c(2,3))
plot(Hitters.ridge.01)
abline(h=0,lty=2,col='black')
title('alpha=0 (Ridge)\n')
plot(Hitters.net.01,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.001\n')
plot(Hitters.net.02,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.3\n')
plot(Hitters.net.03,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.5\n')
plot(Hitters.net.04,xvar="norm")
abline(h=0,lty=2,col='black')
title('alpha=0.999\n')
plot(Hitters.lasso.01)
abline(h=0,lty=2,col='black')
title('alpha=1 (Lasso)\n')
Finalment, podem comparar els coeficients obtinguts mitjançant la lambda que minimitza la mitjana de l'error per a la regressió Lasso.
print('Coeficients regressió Ridge')
coeff.01.ridge<-as.numeric(predict(Hitters.ridge.01,s=bestlam.lasso1,type="coefficients"))
round(coeff.01.ridge,5)
print('Coeficients regressió Elastic Net')
coeff.01.net<-as.numeric(predict(Hitters.net.01,s=bestlam.lasso1,type="coefficients"))
coeff.02.net<-as.numeric(predict(Hitters.net.02,s=bestlam.lasso1,type="coefficients"))
coeff.03.net<-as.numeric(predict(Hitters.net.03,s=bestlam.lasso1,type="coefficients"))
coeff.04.net<-as.numeric(predict(Hitters.net.04,s=bestlam.lasso1,type="coefficients"))
round(coeff.01.net,5)
round(coeff.02.net,5)
round(coeff.03.net,5)
round(coeff.04.net,5)
print('Coeficients regressió Lasso')
coeff.01.lasso<-as.numeric(predict(Hitters.lasso.01,s=bestlam.lasso1,type="coefficients"))
round(coeff.01.lasso,5)
[1] "Coeficients regressió Ridge"
[1] "Coeficients regressió Elastic Net"
[1] "Coeficients regressió Lasso"
Veiem que els coeficients provenents del ridge no presenten cap estimació nul·la, mentre que els coeficients de l'elastic net a mesura que s'aproximen a la regressió lasso, començen a tenir alguns coeficients iguals a zero.