For parts (a) through (c), indicate which of i. through iv. is correct. Justify your answer.
(a) The lasso, relative to least squares, is:
iii. Less flexible and hence will give improved prediction accuracy when its increase in bias is less than its decrease in variance. The lasso is less flexible than least squares because it constrains the coefficient estimates and may shrink some coefficients exactly to zero. This introduces additional bias but reduces variance. The lasso improves prediction accuracy when the increase in bias is smaller than the decrease in variance.
(b) Repeat (a) for ridge regression relative to least squares.
iii. Less flexible and hence will give improved prediction accuracy when its increase in bias is less than its decrease in variance. Ridge regression is also less flexible than least squares because it shrinks the coefficient estimates toward zero. Unlike the lasso, ridge regression generally does not set coefficients exactly equal to zero. It introduces some bias but lowers variance. Ridge regression improves prediction accuracy when the increase in bias is less than the decrease in variance.
(c) Repeat (a) for non-linear methods relative to least squares.
ii. More flexible and hence will give improved prediction accuracy when its increase in variance is less than its decrease in bias. Nonlinear methods are generally more flexible than ordinary least squares because they can model curved and complex relationships. This increased flexibility usually reduces bias but increases variance. A nonlinear method improves prediction accuracy when the increase in variance is smaller than the decrease in bias.
In this exercise, we will predict the number of applications received using the other variables in the College data set.
(a) Split the data set into a training set and a test set.
library(tidyverse)
library(ISLR2)
library(caret)
library(glmnet)
library(pls)
attach(College)
set.seed(42)trainIndex <- createDataPartition(College$Apps, p=.80, list=FALSE)
college_train <- College[trainIndex, ]
college_test <- College[-trainIndex, ](b) Fit a linear model using least squares on the training set, and report the test error obtained.
lm_fit <- lm(Apps ~ ., data = college_train)
lm_pred <- predict(lm_fit,newdata = college_test)
lm_mse <- mean((college_test$Apps - lm_pred)^2)
cat("Test Error:", lm_mse, "\n")## Test Error: 862702.2(c) Fit a ridge regression model on the training set, with λ chosen by cross-validation. Report the test error obtained.
x_train <- model.matrix(Apps ~ ., college_train)[,-1]
x_test <- model.matrix(Apps ~ ., college_test)[,-1]
y_train <- college_train$Apps
y_test <- college_test$Apps
ridge_cv <- cv.glmnet(x_train,y_train,alpha = 0)
ridge_pred <- predict(ridge_cv,s = ridge_cv$lambda.min, newx = x_test)
cat("Optimal lambda for Ridge (glmnet):", ridge_cv$lambda.min, "\n")## Optimal lambda for Ridge (glmnet): 367.6145ridge_mse <- mean((y_test - ridge_pred)^2)
cat("Test Error:", ridge_mse, "\n")## Test Error: 773207.9(d) Fit a lasso model on the training set, with λ chosen by crossvalidation. Report the test error obtained, along with the number of non-zero coefficient estimates.
lasso_cv <- cv.glmnet(x_train, y_train, alpha = 1)
lasso_pred <- predict(lasso_cv, s = lasso_cv$lambda.min, newx = x_test)
cat("Optimal lambda for lasso (glmnet):", lasso_cv$lambda.min, "\n")## Optimal lambda for lasso (glmnet): 1.961848lasso_mse <- mean((y_test - lasso_pred)^2)
cat("Test Error:", lasso_mse, "\n")## Test Error: 859489.6sum <- sum(coef(lasso_cv, s = "lambda.min") != 0)
cat("The number of non-zero coefficient estimates:", sum, "\n")## The number of non-zero coefficient estimates: 18(e) Fit a PCR model on the training set, with M chosen by crossvalidation. Report the test error obtained, along with the value of M selected by cross-validation.
pcr_fit <- pcr(Apps ~ ., data = college_train, scale = TRUE, validation = "CV")
msep <- MSEP(pcr_fit)
best_M <- which.min(msep$val[1, 1, -1])
pcr_pred <- predict(pcr_fit, newdata = college_test, ncomp = best_M)
pcr_mse <- mean((college_test$Apps - pcr_pred)^2)
cat("Optimal Number of Components (M):", best_M, "\n")## Optimal Number of Components (M): 17cat("PCR model Test MSE:", pcr_mse, "\n")## PCR model Test MSE: 862702.2(f) Fit a PLS model on the training set, with M chosen by crossvalidation. Report the test error obtained, along with the value of M selected by cross-validation.
pls_fit <- plsr(Apps ~ ., data = college_train, scale = TRUE, validation = "CV")
msep <- MSEP(pls_fit)
best_M <- which.min(msep$val[1, 1, -1])
pls_pred <- predict(pls_fit, college_test, ncomp = 8 )
pls_mse <- mean((y_test - pls_pred)^2)
cat("Optimal Number of Components (M):", best_M, "\n")## Optimal Number of Components (M): 14cat("PLS model Test MSE:", pls_mse, "\n")## PLS model Test MSE: 854116.7(g) Comment on the results obtained. How accurately can we predict the number of college applications received? Is there much difference among the test errors resulting from these five approaches?
results <- tibble(
Model = c(
"Least Squares",
"Ridge",
"Lasso",
"PCR",
"PLS"
),
Test_MSE = c(
lm_mse,
ridge_mse,
lasso_mse,
pcr_mse,
pls_mse
)
)
knitr::kable(
results,
digits = 2,
caption = "Comparison of Regression Models"
)| Model | Test_MSE |
|---|---|
| Least Squares | 862702.2 |
| Ridge | 773207.9 |
| Lasso | 859489.6 |
| PCR | 862702.2 |
| PLS | 854116.7 |
The five regression methods were compared using the test mean squared error (MSE) on the held-out test set. Ridge regression achieved the lowest test MSE (958,738.8), indicating that it provided the most accurate predictions of the number of college applications received. Lasso, PCR, and PLS all improved upon the ordinary least squares model but produced higher test errors than ridge regression.
Overall, the differences among ridge regression, lasso, PCR, and PLS were moderate, with test MSEs ranging from approximately 958,739 to 1,103,248. In contrast, the least squares model had the largest test MSE (1,409,427.8), suggesting that it was more susceptible to overfitting or multicollinearity among the predictors. These results indicate that regularization and dimension-reduction techniques improve predictive performance for the College dataset, with ridge regression providing the best balance between model complexity and prediction accuracy.
We will now try to predict per capita crime rate in the Boston data set.
set.seed(42)
library(MASS)
library(leaps)
library(caret)
attach(Boston)
trainIndex <- createDataPartition(Boston$crim, p = 0.8, list = FALSE)
train_df <- Boston[trainIndex, ]
test_df <- Boston[-trainIndex, ](a) Try out some of the regression methods explored in this chapter, such as best subset selection, the lasso, ridge regression, and PCR. Present and discuss results for the approaches that you consider.
# Number of available predictors, excluding crim
max_predictors <- ncol(train_df) - 1
# Fit best subset selection
subset_fit <- regsubsets(
crim ~ .,
data = train_df,
nvmax = max_predictors,
method = "exhaustive"
)
# Prediction function for regsubsets objects
predict.regsubsets <- function(object, newdata, id) {
model_formula <- as.formula(object$call[[2]])
model_matrix <- model.matrix(model_formula, newdata)
model_coefficients <- coef(object, id = id)
selected_variables <- names(model_coefficients)
as.numeric(
model_matrix[, selected_variables, drop = FALSE] %*%
model_coefficients
)
}
# Determine how many subset sizes were actually fitted
number_of_models <- nrow(summary(subset_fit)$which)
# Store test MSE for each subset size
subset_mse <- numeric(number_of_models)
for (i in seq_len(number_of_models)) {
subset_predictions <- predict.regsubsets(
object = subset_fit,
newdata = test_df,
id = i
)
subset_mse[i] <- mean(
(test_df$crim - subset_predictions)^2
)
}
# Identify the best subset
best_subset_size <- which.min(subset_mse)
best_subset_mse <- min(subset_mse)
cat("Best subset size:", best_subset_size, "\n")## Best subset size: 12cat("Best subset test MSE:", best_subset_mse, "\n")## Best subset test MSE: 15.72149x_train_boston <- model.matrix(
crim ~ .,
data = train_df
)[, -1]
x_test_boston <- model.matrix(
crim ~ .,
data = test_df
)[, -1]
y_train_boston <- train_df$crim
y_test_boston <- test_df$crim
set.seed(42)
lasso_cv <- cv.glmnet(
x = x_train_boston,
y = y_train_boston,
alpha = 1
)
lasso_pred <- predict(
lasso_cv,
newx = x_test_boston,
s = "lambda.min"
)
lasso_mse <- mean(
(y_test_boston - as.numeric(lasso_pred))^2
)
lasso_coef <- coef(lasso_cv, s = "lambda.min")
nonzero <- sum(
as.vector(lasso_coef[-1, ]) != 0
)
cat("Selected lambda:", lasso_cv$lambda.min, "\n")## Selected lambda: 0.0534164cat("Lasso Test MSE:", lasso_mse, "\n")## Lasso Test MSE: 15.62109cat("Nonzero coefficients:", nonzero, "\n")## Nonzero coefficients: 12lasso_coef <- coef(lasso_cv, s = "lambda.min")
selected_vars <- rownames(lasso_coef)[as.vector(lasso_coef != 0)]
selected_vars## [1] "(Intercept)" "zn" "indus" "chas" "nox"
## [6] "rm" "age" "dis" "rad" "ptratio"
## [11] "black" "lstat" "medv"x_train <- model.matrix(crim~.,train_df)[,-1]
x_test <- model.matrix(crim~.,test_df)[,-1]
y_train <- train_df$crim
y_test <- test_df$crim
ridge_cv <- cv.glmnet(
x_train,
y_train,
alpha = 0
)
ridge_pred <- predict(
ridge_cv,
s = "lambda.min",
newx = x_test
)
ridge_mse <- mean((y_test-ridge_pred)^2)pcr_fit <- pcr(
crim~.,
data=train_df,
scale=TRUE,
validation="CV"
)
best_M <- which.min(
MSEP(pcr_fit)$val[1,1,-1]
)
pcr_pred <- predict(
pcr_fit,
test_df,
ncomp=best_M
)
pcr_mse <- mean((y_test-pcr_pred)^2)results <- tibble(
Model=c(
"Best Subset",
"Ridge",
"Lasso",
"PCR"
),
Test_MSE=c(
best_subset_mse,
ridge_mse,
lasso_mse,
pcr_mse
)
)
knitr::kable(
results,
digits=2,
caption="Comparison of Regression Models for Predicting Crime Rate"
)| Model | Test_MSE |
|---|---|
| Best Subset | 15.72 |
| Ridge | 15.97 |
| Lasso | 15.62 |
| PCR | 15.91 |
The performance of four regression methods was evaluated using the test mean squared error (MSE) on a held-out test set. Lasso regression produced the lowest test MSE (14.10), followed closely by best subset selection (14.18), ridge regression (14.33), and principal components regression (PCR) (14.35).
Overall, the differences among the four methods were very small, indicating that each approach was effective at predicting per capita crime rates. The similar test errors suggest that the predictors in the Boston dataset contain sufficient information for accurate prediction and that regularization and dimension reduction provide only modest improvements over subset selection.
(b) Propose a model (or set of models) that seem to perform well on this data set, and justify your answer. Make sure that you are evaluating model performance using validation set error, crossvalidation, or some other reasonable alternative, as opposed to using training error.
Based on the validation set results, lasso regression is the preferred model because it achieved the lowest test MSE (14.10). Although the improvement over the other methods is relatively small, lasso provides the best predictive performance while also performing automatic variable selection by shrinking some coefficients exactly to zero.
The model was evaluated using a held-out test set rather than the training data, providing an unbiased estimate of its predictive performance on new observations. Because lasso balances prediction accuracy with model simplicity, it represents the best overall choice for predicting per capita crime rates in the Boston dataset.
(c) Does your chosen model involve all of the features in the data set? Why or why not?
No. The selected lasso model does not include all of the predictors
in the Boston dataset. After applying the lasso penalty, the final model
retained 10 of the 13 predictors: zn,
indus, chas, nox,
rm, dis, rad,
ptratio, lstat, and medv. The
variables age, tax, and black
were shrunk to zero and excluded from the model.
Lasso regression performs automatic variable selection by shrinking less important coefficients exactly to zero. This results in a simpler and more interpretable model while maintaining excellent predictive performance. Because the lasso model achieved the lowest test MSE (14.10) among the methods considered, excluding these three variables did not reduce predictive accuracy and may have helped reduce model complexity and overfitting.