Empezemos con una regresión lineal simple:
data("mtcars")
Fit <- lm(mpg ~ wt, data = mtcars)
| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | 37.285 | 1.878 | 19.858 | 0 |
| wt | -5.344 | 0.559 | -9.559 | 0 |
10/11, 2020
Regresión penalizada
Como obtenemos la pendiente y el intercepto?
- Usando mínimos cuadrados
\[\underset{SEE}{\text{minimize}} = \sum_{i = 1}^n{(y_i - \hat{y_i})^2}\]
Minimos cuadrados
Preds <- augment(Fit)
ggplot(Preds, aes(x = wt, y = mpg)) + geom_point() + geom_path(aes(y = .fitted)) +
geom_linerange(aes(ymin = .fitted, ymax = mpg)) + theme_bw()
Suma de errores cuadrados
SSE <- Preds %>% mutate(SE = .resid^2) %>% summarise(SSE = sum(SE))
| SSE |
|---|
| 278.32 |
Ejemplo:
Cuando esto es un problema
- A veces nuestra poblacion es muy distinta a nuestra muestra
Parametros
tidy(Fit_20) %>% kable %>% kable_styling(bootstrap_options = c("striped", "hover"))
| term | estimate | std.error | statistic | p.value |
|---|---|---|---|---|
| (Intercept) | 57.19766 | 5.734954 | 9.973517 | 0.0005678 |
| wt | -12.17175 | 2.033845 | -5.984601 | 0.0039193 |
Penalizamos con \(\lambda\)
- Usando penalización
\[\underset{SEE}{\text{minimize}} = \sum_{i = 1}^n{(y_i - \hat{y_i})^2} + \lambda(\beta_{}^2)\]
Veamos como cambian los parametros:
Seleccionando Lambda
| wt | a0 | Lambda | MinSq | |
|---|---|---|---|---|
| s73 | -5.89 | 39.86 | 7.79 | 308.14 |
Nuestro primer hiperparámetro \(\lambda\)
Usamos cross-validation para seleccionarlo
- ridge: alpha = 0, mejor en predicciones (todas las variables son útiles)
\[\underset{SEE}{\text{minimize}} = \sum_{i = 1}^n{(y_i - \hat{y_i})^2} + \lambda(\beta_{}^2)\]
- Lasso: alpha = 1, selecciona variables (pueden haber variables inutiles)
\[\underset{SEE}{\text{minimize}} = \sum_{i = 1}^n{(y_i - \hat{y_i})^2} + \lambda(\lvert \beta \lvert)\] * Elatic-net: 1 > alpha > 0, intermedio
Comparemos en con hp como en la clase anterior
Ejemplo
library(glmnet) x <- model.matrix(mpg ~ ., data = mtcars) x <- x[, -1] y <- mtcars$mpg
set.seed(2020) ridge <- cv.glmnet(x, y, alpha = 0, nfolds = 10)
set.seed(2020) lasso <- cv.glmnet(x, y, alpha = 1, nfolds = 10)
Ver crossvalidation lasso
plot(lasso)
Variables
Parametros
| Lambda | Parametro | Estimador |
|---|---|---|
| 0.8007036 | cyl | -0.8860854 |
| 0.8007036 | disp | 0.0000000 |
| 0.8007036 | hp | -0.0116844 |
| 0.8007036 | drat | 0.0000000 |
| 0.8007036 | wt | -2.7081470 |
| 0.8007036 | qsec | 0.0000000 |
| 0.8007036 | vs | 0.0000000 |
| 0.8007036 | am | 0.0000000 |
| 0.8007036 | gear | 0.0000000 |
| 0.8007036 | carb | 0.0000000 |
Ridge
Ver crossvalidation lasso
plot(ridge)
Variables
Parametros
| Lambda | Parametro | Estimador |
|---|---|---|
| 3.014597 | cyl | -0.3741127 |
| 3.014597 | disp | -0.0053181 |
| 3.014597 | hp | -0.0115068 |
| 3.014597 | drat | 1.0556295 |
| 3.014597 | wt | -1.2045857 |
| 3.014597 | qsec | 0.1603917 |
| 3.014597 | vs | 0.7870694 |
| 3.014597 | am | 1.5915362 |
| 3.014597 | gear | 0.5417855 |
| 3.014597 | carb | -0.5346265 |
Mejor modelo
Mejor_Lasso <- glmnet(x, y, alpha = 1, lambda = lasso$lambda.min)
Mejor_Ridge <- glmnet(x, y, alpha = 0, lambda = ridge$lambda.min)
Tidy lasso
| term | step | estimate | lambda | dev.ratio |
|---|---|---|---|---|
| (Intercept) | 1 | 35.9990286 | 0.8007036 | 0.8211146 |
| cyl | 1 | -0.8854768 | 0.8007036 | 0.8211146 |
| hp | 1 | -0.0116948 | 0.8007036 | 0.8211146 |
| wt | 1 | -2.7085330 | 0.8007036 | 0.8211146 |
Tidy ridge
| term | step | estimate | lambda | dev.ratio |
|---|---|---|---|---|
| (Intercept) | 1 | 21.0577611 | 3.014597 | 0.8454552 |
| cyl | 1 | -0.3743204 | 3.014597 | 0.8454552 |
| disp | 1 | -0.0053276 | 3.014597 | 0.8454552 |
| hp | 1 | -0.0115164 | 3.014597 | 0.8454552 |
| drat | 1 | 1.0565622 | 3.014597 | 0.8454552 |
| wt | 1 | -1.2043616 | 3.014597 | 0.8454552 |
| qsec | 1 | 0.1602171 | 3.014597 | 0.8454552 |
| vs | 1 | 0.7857236 | 3.014597 | 0.8454552 |
| am | 1 | 1.5902892 | 3.014597 | 0.8454552 |
| gear | 1 | 0.5411800 | 3.014597 | 0.8454552 |
| carb | 1 | -0.5343506 | 3.014597 | 0.8454552 |
Elastic net
Elastic net
\[\underset{SEE}{\text{minimize}} = \sum_{i = 1}^n{(y_i - \hat{y_i})^2} + \lambda(\alpha\times\lvert \beta \lvert + (1- \alpha)\times \beta^2)\] # Que alfa uso? (segundo hiperparámetro)
Preparemos los folds:
library(caret) set.seed(2020) Index <- createDataPartition(mtcars$mpg, p = 0.8, list = F) Train <- mtcars[Index, ] Test <- mtcars[-Index, ] set.seed(2020) Folds <- createFolds(Train$mpg, k = 10, list = F)
Generemos los modelos
x <- model.matrix(mpg ~ ., data = Train) x <- x[, -1] y <- Train$mpg lasso <- cv.glmnet(x, y, alpha = 1, foldid = Folds) ridge <- cv.glmnet(x, y, alpha = 0, foldid = Folds) ElasticNet <- cv.glmnet(x, y, alpha = 0.5, foldid = Folds)
Mejores modelos
Mejor_Lasso <- glmnet(x, y, alpha = 1, lambda = lasso$lambda.min) Mejor_Ridge <- glmnet(x, y, alpha = 0, lambda = ridge$lambda.min) Mejor_Elastic <- glmnet(x, y, alpha = 0.5, lambda = ElasticNet$lambda.min)
Testeo
NewX <- model.matrix(mpg ~ ., data = Test) NewX <- NewX[, -1] NewY <- Test$mpg caret::postResample(pred = predict(Mejor_Ridge, newx = NewX), obs = NewY)
## RMSE Rsquared MAE ## 2.3963952 0.9562932 2.1473740
caret::postResample(pred = predict(Mejor_Lasso, newx = NewX), obs = NewY)
## RMSE Rsquared MAE ## 3.3250799 0.8561916 2.5226143
caret::postResample(pred = predict(Mejor_Elastic, newx = NewX), obs = NewY)
## RMSE Rsquared MAE ## 3.2308941 0.8700966 2.4776365
Tiene las mismas familias que glm
Binomial
train <- read_csv("https://raw.githubusercontent.com/derek-corcoran-barrios/derek-corcoran-barrios.github.io/master/CursoMultiPres/Capitulo_3/train.csv")
train <- train[complete.cases(train), ]
x <- model.matrix(Survived ~ ., data = train) x <- x[, -1] y <- train$Survived set.seed(2020) Fit <- cv.glmnet(x, y, nfolds = 10, family = "binomial", alpha = 1)
Mejor modelo
mejor.Fit <- glmnet(x, y, family = "binomial", alpha = 1, lambda = Fit$lambda.min)
tidy(mejor.Fit)
## # A tibble: 0 x 5 ## # … with 5 variables: term <chr>, step <dbl>, estimate <dbl>, lambda <dbl>, ## # dev.ratio <dbl>