For parts (a) through (c), indicate which of i. through iv. is correct. Justify your answer. a) The lasso, relative to least squares, is: i. More flexible and hence will give improved prediction accuracy when its increase in bias is less than its decrease in variance. ii. More flexible and hence will give improved prediction accuracy when its increase in variance is less than its decrease in bias. iii. Less flexible and hence will give improved prediction accuracy when its increase in bias is less than its decrease in variance. iv. Less flexible and hence will give improved prediction accuracy when its increase in variance is less than its decrease in bias.
iii is correct because lasso method shrinks the coefficient towards zero, improving accuracy, decreasing variance, and increasing bias relative to least squares.
Repeat (a) for ridge regression relative to least squares. -ridge regression also constrains the coefficients toward zero, which is again less flexible than ordinary least squares (iii is correct, decrease variance, increasing bias).
Repeat (a) for non-linear methods relative to least squares. non-linear methods are more flexible than least squares since least squares is forcing a fit onto a linear relationship while non-linear don’t have this assumption.lowers bias, increase variance (ii is correct)
In this exercise, we will predict the number of applications received using the other variables in the College data set.
library(ISLR)
## Warning: package 'ISLR' was built under R version 4.6.1
library(ISLR2)
## Warning: package 'ISLR2' was built under R version 4.6.1
##
## Attaching package: 'ISLR2'
## The following objects are masked from 'package:ISLR':
##
## Auto, Credit
library(glmnet)
## Warning: package 'glmnet' was built under R version 4.6.1
## Loading required package: Matrix
## Loaded glmnet 5.0
library(pls)
## Warning: package 'pls' was built under R version 4.6.1
##
## Attaching package: 'pls'
## The following object is masked from 'package:stats':
##
## loadings
attach(College)
set.seed(2)
n <- nrow(College)
train_index <- sample(1:n, n / 2)
test_index <- (1:n)[-train_index]
train <- College[train_index, ]
test <- College[test_index, ]
lm_fit <- lm(Apps ~ ., data = train)
lm_pred <- predict(lm_fit, test)
lm_test_error <- mean((lm_pred - test$Apps)^2)
lm_test_error
## [1] 1093608
train_mat <- model.matrix(Apps ~ ., data = train)[, -1]
test_mat <- model.matrix(Apps ~ ., data = test)[, -1]
train_y <- train$Apps
test_y <- test$Apps
set.seed(2)
ridge_cv <- cv.glmnet(train_mat, train_y, alpha = 0)
ridge_lambda <- ridge_cv$lambda.min
ridge_lambda
## [1] 424.2704
ridge_fit <- glmnet(train_mat, train_y, alpha = 0, lambda = ridge_lambda)
ridge_pred <- predict(ridge_fit, s = ridge_lambda, newx = test_mat)
ridge_test_error <- mean((ridge_pred - test_y)^2)
ridge_test_error
## [1] 1138219
set.seed(2)
lasso_cv <- cv.glmnet(train_mat, train_y, alpha = 1)
lasso_lambda <- lasso_cv$lambda.min
lasso_lambda
## [1] 15.97351
lasso_fit <- glmnet(train_mat, train_y, alpha = 1, lambda = lasso_lambda)
lasso_pred <- predict(lasso_fit, s = lasso_lambda, newx = test_mat)
lasso_test_error <- mean((lasso_pred - test_y)^2)
lasso_test_error
## [1] 1045983
lasso_coef <- predict(lasso_fit, s = lasso_lambda, type = "coefficients")
lasso_coef
## 18 x 1 sparse Matrix of class "dgCMatrix"
## s=15.97351
## (Intercept) -1.016974e+03
## PrivateYes -4.073768e+02
## Accept 1.564096e+00
## Enroll -7.907839e-01
## Top10perc 2.957343e+01
## Top25perc -1.103142e+00
## F.Undergrad 5.285454e-02
## P.Undergrad 4.787830e-02
## Outstate -6.829886e-02
## Room.Board 1.361730e-01
## Books 6.152820e-02
## Personal 2.733287e-02
## PhD -7.728516e+00
## Terminal -3.138253e+00
## S.F.Ratio 3.746685e+01
## perc.alumni .
## Expend 8.457715e-02
## Grad.Rate 4.218258e+00
sum(lasso_coef != 0)
## [1] 17
set.seed(2)
pcr_fit <- pcr(Apps ~ ., data = train, scale = TRUE, validation = "CV")
best_M_pcr <- which.min(pcr_fit$validation$PRESS)
best_M_pcr
## [1] 17
pcr_pred <- predict(pcr_fit, test, ncomp = best_M_pcr)
pcr_test_error <- mean((pcr_pred - test$Apps)^2)
pcr_test_error
## [1] 1093608
set.seed(2)
pls_fit <- plsr(Apps ~ ., data = train, scale = TRUE, validation = "CV")
best_M_pls <- which.min(pls_fit$validation$PRESS)
best_M_pls
## [1] 12
pls_pred <- predict(pls_fit, test, ncomp = best_M_pls)
pls_test_error <- mean((pls_pred - test$Apps)^2)
pls_test_error
## [1] 1085346
-We can comfortable predict the number of college apps received.Lasso has the lowest test error, while Ridge has the highest. PLS PCR and LS all performed similarly with test errors but Lasso performed relatively better while Ridge performed relatively worse.
test_errors <- c(lm_test_error, ridge_test_error, lasso_test_error, pcr_test_error, pls_test_error)
names(test_errors) <- c("LS", "Ridge", "Lasso", "PCR", "PLS")
sort(test_errors)
## Lasso PLS PCR LS Ridge
## 1045983 1085346 1093608 1093608 1138219
We will now try to predict per capita crime rate in the Boston data set.
library(ISLR)
library(ISLR2)
library(glmnet)
library(pls)
library(leaps)
## Warning: package 'leaps' was built under R version 4.6.1
attach(Boston)
set.seed(1)
n <- nrow(Boston)
train_index <- sample(1:n, n/2)
train <- Boston[train_index,]
test <- Boston[-train_index,]
lm_fit <- lm(crim ~ ., data = train)
lm_pred <- predict(lm_fit, test)
lm_test_error <- mean((lm_pred - test$crim)^2)
lm_test_error
## [1] 41.19923
train_mat <- model.matrix(crim ~ ., train)[,-1]
test_mat2 <- model.matrix(crim ~ ., test)[,-1]
train_y <- train$crim
test_y <- test$crim
set.seed(1)
ridge_cv <- cv.glmnet(train_mat, train_y, alpha = 0)
ridge_lambda <- ridge_cv$lambda.min
ridge_pred <- predict(ridge_cv, s = "lambda.min", newx = test_mat2)
ridge_test_error <- mean((ridge_pred - test_y)^2)
ridge_test_error
## [1] 40.17065
set.seed(1)
lasso_cv <- cv.glmnet(train_mat, train_y, alpha = 1)
lasso_lambda <- lasso_cv$lambda.min
lasso_pred <- predict(lasso_cv,s = "lambda.min", newx = test_mat2)
lasso_test_error <- mean((lasso_pred - test_y)^2)
lasso_test_error
## [1] 40.89958
lasso_coef <- coef(lasso_cv, s = "lambda.min")
sum(lasso_coef[-1] != 0)
## [1] 12
set.seed(1)
pcr_fit <- pcr(crim ~ ., data = train, scale = TRUE, validation = "CV")
best_M <- which.min(pcr_fit$validation$PRESS)
best_M
## [1] 12
pcr_pred <- predict(pcr_fit, test, ncomp = best_M)
pcr_test_error <- mean((pcr_pred - test$crim)^2)
pcr_test_error
## [1] 41.19923
test_errors <- c(LS1 = lm_test_error, Ridge1 = ridge_test_error, Lasso1 = lasso_test_error, PCR1 = pcr_test_error)
sort(test_errors)
## Ridge1 Lasso1 LS1 PCR1
## 40.17065 40.89958 41.19923 41.19923
-Ridge, Lasso, LS, and PCR all score relatively the same. However, Ridge performs the best at 40.17 and LS and PCR equally perform the worst at 41.20
-Based on our test error, Ridge would perform the best due to having the lowest test error rate.
yes, we used all the features in Ridge because the coefficients are shrunk towards 0 but do not equal 0, keeping them but making them less important.