Question 2
# (2a)
invisible("iii - Lasso is less flexible than ordinary least squares because it constrains the model by shrinking some coefficients all the way to zero. This restriction naturally increases the model's bias but decreases its variance. Lasso yields better prediction accuracy than least squares only when the reduction in variance is greater than the increase in bias.")
# (2b)
invisible("iii - Ridge regression is less flexible than ordinary least squares because it constrains the coefficients by shrinking them toward zero. This restriction introduces a small increase in bias but leads to a significant decrease in variance. Ridge regression provides better prediction accuracy than least squares only when its increase in bias is less than its decrease in variance.")
# (2c)
invisible("ii - Non-linear methods are more flexible than ordinary least squares because they can fit complex, curved relationships instead of just straight lines. Added flexibility reduces the model's bias but increases its variance. Non-linear methods provide better prediction accuracy than least squares only when the reduction in bias is greater than the increase in variance.")
Question 9
# (9a)
set.seed(1)
train_idx <- sample(1:nrow(College), 0.7 * nrow(College))
train <- College[train_idx, ]
test <- College[-train_idx, ]
# (9b)
lm_fit <- lm(Apps ~ ., data = train)
lm_pred <- predict(lm_fit, test)
mean((test$Apps - lm_pred)^2)
## [1] 1261630
# (9c)
x_train <- model.matrix(Apps ~ ., train)[, -1]
x_test <- model.matrix(Apps ~ ., test)[, -1]
set.seed(1)
cv_ridge <- cv.glmnet(x_train, train$Apps, alpha = 0)
ridge_pred <- predict(cv_ridge, s = cv_ridge$lambda.min, newx = x_test)
mean((test$Apps - ridge_pred)^2)
## [1] 1121034
# (9d)
set.seed(1)
cv_lasso <- cv.glmnet(x_train, train$Apps, alpha = 1)
lasso_pred <- predict(cv_lasso, s = cv_lasso$lambda.min, newx = x_test)
mean((test$Apps - lasso_pred)^2)
## [1] 1233246
predict(cv_lasso, s = cv_lasso$lambda.min, type = "coefficients")
## 18 x 1 sparse Matrix of class "dgCMatrix"
## s=8.690175
## (Intercept) -587.01736837
## PrivateYes -467.41899274
## Accept 1.66632106
## Enroll -0.73933203
## Top10perc 47.57728851
## Top25perc -11.81001203
## F.Undergrad .
## P.Undergrad 0.06051514
## Outstate -0.07687500
## Room.Board 0.15109731
## Books 0.21880229
## Personal .
## PhD -8.55085494
## Terminal -0.11958847
## S.F.Ratio 11.05918988
## perc.alumni .
## Expend 0.05724753
## Grad.Rate 6.16903184
# (9e)
set.seed(1)
pcr_fit <- pcr(Apps ~ ., data = train, scale = TRUE, validation = "CV")
validationplot(pcr_fit, val.type = "MSEP")
pcr_pred <- predict(pcr_fit, test, ncomp = 16)
mean((test$Apps - pcr_pred)^2)
## [1] 1332330
# (9f)
set.seed(1)
pls_fit <- plsr(Apps ~ ., data = train, scale = TRUE, validation = "CV")
validationplot(pls_fit, val.type = "MSEP")
pls_pred <- predict(pls_fit, test, ncomp = 10)
mean((test$Apps - pls_pred)^2)
## [1] 1279353
# (9g)
invisible("All five models predict the number of college applications with a similar level of accuracy, as their test errors are clustered closely between 1.12 and 1.33 million. Ridge regression performs the best overall, while the Lasso model provides a slightly higher error but offers a simpler, more interpretable model by eliminating three variables entirely. The competitive performance of ordinary least squares indicates that the underlying relationship in the data is mostly linear.")
Question 11
# (11a)
set.seed(1)
train_idx <- sample(1:nrow(Boston), 0.7 * nrow(Boston))
train <- Boston[train_idx, ]
test <- Boston[-train_idx, ]
x_train <- model.matrix(crim ~ ., train)[, -1]
x_test <- model.matrix(crim ~ ., test)[, -1]
lm_fit <- lm(crim ~ ., data = train)
lm_err <- mean((test$crim - predict(lm_fit, test))^2)
cv_ridge <- cv.glmnet(x_train, train$crim, alpha = 0)
ridge_err <- mean((test$crim - predict(cv_ridge, s = cv_ridge$lambda.min, newx = x_test))^2)
cv_lasso <- cv.glmnet(x_train, train$crim, alpha = 1)
lasso_err <- mean((test$crim - predict(cv_lasso, s = cv_lasso$lambda.min, newx = x_test))^2)
pcr_fit <- pcr(crim ~ ., data = train, scale = TRUE, validation = "CV")
pcr_err <- mean((test$crim - predict(pcr_fit, test, ncomp = 12))^2)
cat(" OLS Error:", lm_err, "\n Ridge Error:", ridge_err, "\n Lasso Error:", lasso_err, "\n PCR Error:", pcr_err)
## OLS Error: 57.61252
## Ridge Error: 58.75168
## Lasso Error: 58.06509
## PCR Error: 57.61252
# (11b)
invisible("The Ordinary Least Squares (OLS) model is the best choice because it achieved the lowest validation error (58.92), outperforming Lasso, Ridge, and PCR. Since the basic linear model beats the shrinkage methods, it suggests that most predictors have a meaningful impact on crime rate that shouldn't be restricted.")
# (11c)
invisible("Ordinary Least Squares (OLS) model involves all of the features in the dataset. Unlike Lasso or best subset selection, OLS does not have a built-in mechanism to perform variable selection or force coefficients to zero. It calculates a coefficient for every single available predictor in the training data, meaning all features are kept and used to make predictions on the test set.")