Assignment5

Problem 2

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. Compared to least Squares, The Lasso adds a penalty to the regression coefficients, shrinking some toward zero and even setting some exactly to zero. That makes the model less flexible, higher bias because of the constrained coefficients and lower variance because it’s less sensitive to training data.

(b) Repeat (a) for ridge regression relative to least squares.

• iii is correct. Ridge regression works the same way as the lasso in this regard. It shrinks coefficients toward zero but never actually zero, making it less flexible than least squares.With the same high bias and low variance trade off.

(c) Repeat (a) for non-linear methods relative to least squares.

• ii is correct. Non-linear methods are different though, they are more flexible than least squares. With the increase in flexibility it will make the bias decrease and the variance increase. They work better when the decrease in bias is larger then the increase in variance, especially when the relationship in not linear.

---

Problem 9

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(ISLR2)
library(glmnet)
library(pls)

set.seed(1)
n <- nrow(College)
train_idx <- sample(1:n, size = floor(0.60 * n))
college_train <- College[train_idx, ]
college_test  <- College[-train_idx, ]

(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, college_test)
mean((lm_pred - college_test$Apps)^2)

[1] 1124482

(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]
y_train <- college_train$Apps
x_test  <- model.matrix(Apps ~ ., college_test)[, -1]
y_test  <- college_test$Apps

set.seed(1)
cv_ridge   <- cv.glmnet(x_train, y_train, alpha = 0)
best_lam <- cv_ridge$lambda.min

ridge_pred <- predict(cv_ridge, s = best_lam, newx = x_test)
ridge_mse  <- mean((ridge_pred - y_test)^2)

cat("Best Lam:", best_lam, "\n")

Best Lam: 382.881 

cat("Ridge test MSE:", ridge_mse, "\n")

Ridge test MSE: 1032921 

(d) Fit a lasso model on the training set, with λ chosen by cross-validation. Report the test error obtained, along with the number of non-zero coefficient estimates.

set.seed(1)
cv_lasso   <- cv.glmnet(x_train, y_train, alpha = 1)
best_lam_lasso <- cv_lasso$lambda.min

lasso_pred <- predict(cv_lasso, s = best_lam_lasso, newx = x_test)
lasso_mse  <- mean((lasso_pred - y_test)^2)

lasso_coef <- predict(cv_lasso,type = "coefficients", s = best_lam_lasso)
nonzero    <- sum(lasso_coef != 0) - 1 

cat("Best Lam:", best_lam_lasso, "\n")

Best Lam: 17.36319 

cat("Lasso test MSE:", lasso_mse, "\n")

Lasso test MSE: 1076820 

cat("Number fo non-zero coef:", nonzero, "\n")

Number fo non-zero coef: 13 

(e) Fit a PCR model on the training set, with M chosen by cross-validation. Report the test error obtained, along with the value of M selected by cross-validation.

set.seed(1)
pcr_fit <- pcr(Apps ~ ., data = college_train, scale = TRUE, validation = "CV")
validationplot(pcr_fit, val.type = "MSEP")

summary(pcr_fit)

Data:   X dimension: 466 17 
    Y dimension: 466 1
Fit method: svdpc
Number of components considered: 17

VALIDATION: RMSEP
Cross-validated using 10 random segments.
       (Intercept)  1 comps  2 comps  3 comps  4 comps  5 comps  6 comps  7 comps  8 comps  9 comps  10 comps
CV            4061     3921     2228     2215     1942     1781     1773     1757     1724     1668      1652
adjCV         4061     3920     2224     2213     1920     1774     1768     1767     1710     1663      1646
       11 comps  12 comps  13 comps  14 comps  15 comps  16 comps  17 comps
CV         1650      1659      1653      1680      1655      1242      1209
adjCV      1645      1653      1648      1684      1635      1230      1199

TRAINING: % variance explained
      1 comps  2 comps  3 comps  4 comps  5 comps  6 comps  7 comps  8 comps  9 comps  10 comps  11 comps
X      32.483    57.59    64.96    70.64    75.98    80.99    84.43    87.80    90.66     92.92     95.01
Apps    8.553    71.18    71.47    80.53    82.20    82.57    82.66    84.02    84.54     84.94     84.95
      12 comps  13 comps  14 comps  15 comps  16 comps  17 comps
X        96.78     97.82     98.69     99.37     99.85    100.00
Apps     84.99     85.19     85.23     89.92     93.18     93.39

# Select M with lowest CV error
cv_errs <- MSEP(pcr_fit)$val[1, 1, ]
best_M  <- which.min(cv_errs[-1])  # exclude intercept-only

pcr_pred <- predict(pcr_fit, college_test, ncomp = best_M)
pcr_mse  <- mean((pcr_pred - college_test$Apps)^2)

cat("Best M (PCR):", best_M, "\n")

Best M (PCR): 17 

cat("PCR Test MSE:", pcr_mse, "\n")

PCR Test MSE: 1124482 

(f) Fit a PLS model on the training set, with M chosen by cross-validation. Report the test error obtained, along with the value of M selected by cross-validation.

set.seed(1)
pls_fit <- plsr(Apps ~ ., data = college_train, scale = TRUE, validation = "CV")
validationplot(pls_fit, val.type = "MSEP")

summary(pls_fit)

Data:   X dimension: 466 17 
    Y dimension: 466 1
Fit method: kernelpls
Number of components considered: 17

VALIDATION: RMSEP
Cross-validated using 10 random segments.
       (Intercept)  1 comps  2 comps  3 comps  4 comps  5 comps  6 comps  7 comps  8 comps  9 comps  10 comps
CV            4061     2058     1844     1586     1536     1404     1286     1246     1223     1215      1213
adjCV         4061     2053     1838     1578     1514     1384     1269     1233     1212     1204      1202
       11 comps  12 comps  13 comps  14 comps  15 comps  16 comps  17 comps
CV         1214      1211      1210      1209      1209      1209      1209
adjCV      1203      1200      1199      1199      1199      1199      1199

TRAINING: % variance explained
      1 comps  2 comps  3 comps  4 comps  5 comps  6 comps  7 comps  8 comps  9 comps  10 comps  11 comps
X       26.31    50.01    62.94    65.76    70.18    74.34    77.94    81.22    83.06     86.39     89.37
Apps    75.94    81.67    87.08    90.72    92.44    93.14    93.24    93.29    93.34     93.36     93.37
      12 comps  13 comps  14 comps  15 comps  16 comps  17 comps
X        91.15     92.33     94.24     97.03     98.16    100.00
Apps     93.38     93.39     93.39     93.39     93.39     93.39

cv_errs_pls <- MSEP(pls_fit)$val[1, 1, ]
best_M_pls  <- which.min(cv_errs_pls[-1])

pls_pred <- predict(pls_fit, college_test, ncomp = best_M_pls)
pls_mse  <- mean((pls_pred - college_test$Apps)^2)

cat("Best M (PLS):", best_M_pls, "\n")

Best M (PLS): 15 

cat("PLS Test MSE:", pls_mse, "\n")

PLS Test MSE: 1124526 

(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?

• The different methods produced similar test MSE values, all performed similarly when predicting the number of college applications received. Ridge regression had the lowest test MSE (1032921), followed by lasso (1076820), while PCR and PLS had slightly higher errors (around 1124000). Overall, the models were able to predict applications reasonably well, but no single method provided a major improvement over the others.

---

Problem 11

(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.

library(leaps)

set.seed(1)
n_bos <- nrow(Boston)
bos_train_idx <- sample(1:n_bos, size = floor(0.65 * n_bos))
bos_train <- Boston[bos_train_idx, ]
bos_test  <- Boston[-bos_train_idx, ]

x_bos_train <- model.matrix(crim ~ ., bos_train)[, -1]
y_bos_train <- bos_train$crim
x_bos_test  <- model.matrix(crim ~ ., bos_test)[, -1]
y_bos_test  <- bos_test$crim

-Best Subset

regfit.full <- regsubsets(crim ~ ., data = bos_train, nvmax = 12) 
regfit.summary <- summary(regfit_full) 
par(mfrow=c(2,2))

par(mfrow=c(2,2 ))
plot(regfit.summary$rss,xlab ="Number of Variables", ylab = "RSS", type = "l")
plot(regfit.summary$adjr2,xlab ="Number of Variables", ylab = "adjr2", type = "l")

which.max(regfit.summary$adjr2)

[1] 8

points(11,regfit.summary$adjr2[11],col='red', cex=2,pch=20)
plot(regfit.summary$cp,xlab ="Number of Variables", ylab = "cp", type = "l")

which.min(regfit.summary$cp)

[1] 6

points(10,regfit.summary$cp[10],col='red', cex=2,pch=20)
plot(regfit.summary$bic,xlab ="Number of Variables", ylab = "bic", type = "l")

which.min(regfit.summary$bic)

[1] 2

points(6,regfit.summary$bic[6],col='red', cex=2,pch=20)

test_mat <- model.matrix(crim ~ ., data = bos_test)
best_size <- 11  
best_coef <- coef(regfit.full, id = best_size)
best_pred <- test_mat[, names(best_coef)] %*% best_coef
best_subset_mse <- mean((bos_test$crim - best_pred)^2)
best_subset_mse

[1] 50.2209

-Lasso

# Lasso
grid <- 10^seq(10, -2, length = 100)
lasso_mod <- glmnet(x_bos_train, y_bos_train, alpha = 1, lambda = grid)

set.seed(1)
cv_lasso_bos <- cv.glmnet(x_bos_train, y_bos_train, alpha = 1)

best_lam_boslasso <- cv_lasso_bos$lambda.min
lasso_pred_bos <- predict(lasso_mod, s = best_lam_boslasso, newx = x_bos_test)
lasso_mse_bos <- mean((lasso_pred_bos - y_bos_test)^2)
lasso_coef_bos <- predict(lasso_mod, s = cv_lasso_bos$lambda.min, type = "coefficients")
nonzero_bos <- sum(lasso_coef_bos != 0) -1

best_lam_boslasso 

[1] 0.0422181

lasso_mse_bos 

[1] 50.5437

lasso_coef_bos 

13 x 1 sparse Matrix of class "dgCMatrix"
            s=0.0422181
(Intercept)  9.15341877
zn           0.03465035
indus       -0.08413468
chas        -0.74979794
nox         -5.49801258
rm           0.17307922
age          .         
dis         -0.65772034
rad          0.52416009
tax          .         
ptratio     -0.29138583
lstat        0.23187008
medv        -0.13506184

nonzero_bos 

[1] 10

-PCR

# PCR
set.seed(1)
pcr_bos <- pcr(crim ~ ., data = bos_train, scale = TRUE, validation = "CV")
validationplot(pcr_bos, val.type = "MSEP")

cv_errs_bos <- MSEP(pcr_bos)$val[1, 1, ]
best_M_bos  <- which.min(cv_errs_bos[-1])

pcr_pred_bos <- predict(pcr_bos, bos_test, ncomp = best_M_bos)
pcr_mse_bos  <- mean((pcr_pred_bos - bos_test$crim)^2)

cat("Best M (PCR):", best_M_bos, "\n")

Best M (PCR): 12 

cat("PCR Test MSE:", pcr_mse_bos, "\n")

PCR Test MSE: 50.22142 

• The three methods produced similar test MSE values on the data, meaning they performed similarly when predicting crime rate. Both the subset and lasso reduced the number of predictors in the model to come up with there better predictions. PCR used combinations of the original predictors instead of selecting individual variables.

(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, cross-validation, or some other reasonable alternative, as opposed to using training error.

comparison <- data.frame(
  Method   = c("Best Subset", "Lasso", "PCR"),
  Test_MSE = c(best_subset_mse, lasso_mse_bos, pcr_mse_bos)
)
comparison

• Based on the test results, I would choose the PCR model as the best approach because it has the lowest MSE. However, the differences between the models were super small, all three methods performed similarly when predicting new data. Best subset selection and lasso produced simpler models that are easier to interpret, while PCR provided slightly better prediction performance. Overall, PCR would be the preferred model for prediction, while lasso or best subset could be useful if interpret ability is more important.

(c) Does your chosen model involve all of the features in the data set? Why or why not?

• No. The PCR model does not use the original features. It combines the features into a smaller number of principal components that capture the most important patterns in the data. This allows the model to use the information from many variables while reducing unnecessary complexity. PCR was chosen because it provided the lowest test MSE, meaning it performed slightly better at predicting crime rate on new data.