##2. iii. Lasso is a less flexible model than OLS. It increases bias and decreases variance. If the variance decreases and this outweighs the rise in bias, that helps accuracy overall. iii. Ridge is also a less flexible model than OLS. It increases bias and decreases variance. If the variance decreases and this outweighs the rise in bias, that helps accuracy overall. ii. Unlike ridge and lasso, non-linear methods are more flexible than OLS. Since it’s more flexible, it can better fit the training data, which decreases bias and increases variance. If the variance increases and this outweighs the decrease in bias, that helps accuracy overall.

##9a Split

## Warning: package 'ISLR2' was built under R version 4.5.3
## Warning: package 'caret' was built under R version 4.5.3
## Loading required package: ggplot2
## Loading required package: lattice
## Warning: package 'glmnet' was built under R version 4.5.3
## Loading required package: Matrix
## Loaded glmnet 5.0
## Warning: package 'pls' was built under R version 4.5.3
## 
## Attaching package: 'pls'
## The following object is masked from 'package:caret':
## 
##     R2
## The following object is masked from 'package:stats':
## 
##     loadings
## Warning: package 'leaps' was built under R version 4.5.3
data(College)
set.seed(1)

trainIndex <- createDataPartition(College$Apps, p = 0.7, list = FALSE)
train <- College[trainIndex, ]
test  <- College[-trainIndex, ]

ctrl <- trainControl(method = "cv", number = 10)

##9b Least Squares Linear Model & Test Error

set.seed(1)
lm_fit <- train(Apps ~ ., data = train,
                method = "lm",
                trControl = ctrl)

lm_pred <- predict(lm_fit, newdata = test)
lm_mse <- mean((lm_pred - test$Apps)^2)
lm_mse
## [1] 921637.5

##9c Ridge Model & Test Error

set.seed(1)
ridge_grid <- expand.grid(alpha = 0, lambda = 10^seq(4, -2, length = 100))
ridge_fit <- train(Apps ~ ., data = train,
                   method = "glmnet",
                   trControl = ctrl,
                   tuneGrid = ridge_grid)

ridge_fit$bestTune
##    alpha   lambda
## 75     0 305.3856
ridge_pred <- predict(ridge_fit, newdata = test)
ridge_mse <- mean((ridge_pred - test$Apps)^2)
ridge_mse
## [1] 1032561

##9d Lasso Model & Test Error

set.seed(1)
lasso_grid <- expand.grid(alpha = 1, lambda = 10^seq(4, -2, length = 100))
lasso_fit <- train(Apps ~ ., data = train,
                   method = "glmnet",
                   trControl = ctrl,
                   tuneGrid = lasso_grid)
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
lasso_fit$bestTune
##    alpha   lambda
## 59     1 32.74549
lasso_pred <- predict(lasso_fit, newdata = test)
lasso_mse <- mean((lasso_pred - test$Apps)^2)
lasso_mse
## [1] 956502.3
lasso_coef <- coef(lasso_fit$finalModel, lasso_fit$bestTune$lambda)
sum(lasso_coef != 0)
## [1] 12

##9e PCR Model & Test Error

set.seed(1)
pcr_fit <- train(Apps ~ ., data = train,
                 method = "pcr",
                 trControl = ctrl,
                 tuneLength = 17,
                 preProcess = c("center", "scale"))

pcr_fit$bestTune
##    ncomp
## 16    16
pcr_pred <- predict(pcr_fit, newdata = test)
pcr_mse <- mean((pcr_pred - test$Apps)^2)
pcr_mse
## [1] 1000907

##9f PLS Model & Test Error

set.seed(1)
pls_fit <- train(Apps ~ ., data = train,
                 method = "pls",
                 trControl = ctrl,
                 tuneLength = 17,
                 preProcess = c("center", "scale"))

pls_fit$bestTune
##   ncomp
## 9     9
pls_pred <- predict(pls_fit, newdata = test)
pls_mse <- mean((pls_pred - test$Apps)^2)
pls_mse
## [1] 937807.7

##9g

results <- data.frame(
  Method = c("Least Squares", "Ridge", "Lasso", "PCR", "PLS"),
  Test_MSE = c(lm_mse, ridge_mse, lasso_mse, pcr_mse, pls_mse)
)

results$RMSE <- sqrt(results$Test_MSE)
results
##          Method  Test_MSE      RMSE
## 1 Least Squares  921637.5  960.0195
## 2         Ridge 1032561.1 1016.1502
## 3         Lasso  956502.3  978.0093
## 4           PCR 1000906.6 1000.4532
## 5           PLS  937807.7  968.4047

Least squares has the lowest RMSE at 960.0195, while ridge has the highest RMSE at 1016.1502.

mean(College$Apps)
## [1] 3001.638
sd(College$Apps)
## [1] 3870.201
range(College$Apps)
## [1]    81 48094

The data is right skewed with a mean of 3001.639 applications recieved, a standard deviation of 3870.201 applications, and a range from 81 to 48094 applications. Prediction error is around 1000 applications, meaning errors in the number of applications predicted fluctuates by about 1000 from the real value. Least Squares and PLS are the best models, but not by a lot. The models are very similar.

##11a

data(Boston)
set.seed(1)

trainIndex <- createDataPartition(Boston$crim, p = 0.7, list = FALSE)
train <- Boston[trainIndex, ]
test  <- Boston[-trainIndex, ]

ctrl <- trainControl(method = "cv", number = 10)

set.seed(1)
ridge_grid <- expand.grid(alpha = 0, lambda = 10^seq(4, -2, length = 100))
ridge_fit <- train(crim ~ ., data = train,
                   method = "glmnet",
                   trControl = ctrl,
                   tuneGrid = ridge_grid)
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
ridge_pred <- predict(ridge_fit, newdata = test)
ridge_mse <- mean((ridge_pred - test$crim)^2)
ridge_mse
## [1] 21.21518
set.seed(1)
lasso_grid <- expand.grid(alpha = 1, lambda = 10^seq(4, -2, length = 100))
lasso_fit <- train(crim ~ ., data = train,
                   method = "glmnet",
                   trControl = ctrl,
                   tuneGrid = lasso_grid)
## Warning in nominalTrainWorkflow(x = x, y = y, wts = weights, info = trainInfo,
## : There were missing values in resampled performance measures.
lasso_pred <- predict(lasso_fit, newdata = test)
lasso_mse <- mean((lasso_pred - test$crim)^2)
lasso_mse
## [1] 21.42649
lasso_coef <- coef(lasso_fit$finalModel, lasso_fit$bestTune$lambda)
sum(lasso_coef != 0)
## [1] 5
set.seed(1)
pcr_fit <- train(crim ~ ., data = train,
                 method = "pcr",
                 trControl = ctrl,
                 tuneLength = 13,
                 preProcess = c("center", "scale"))

pcr_fit$bestTune
##    ncomp
## 10    10
pcr_pred <- predict(pcr_fit, newdata = test)
pcr_mse <- mean((pcr_pred - test$crim)^2)
pcr_mse
## [1] 21.28369
set.seed(1)
lm_fit <- train(crim ~ ., data = train,
                 method = "lm",
                 trControl = ctrl)

lm_pred <- predict(lm_fit, newdata = test)
lm_mse <- mean((lm_pred - test$crim)^2)
lm_mse
## [1] 22.57552
set.seed(1)
pls_fit <- train(crim ~ ., data = train,
                  method = "pls",
                  trControl = ctrl,
                  tuneLength = 13,
                  preProcess = c("center", "scale"))

pls_fit$bestTune          # optimal number of components M
##   ncomp
## 3     3
pls_pred <- predict(pls_fit, newdata = test)
pls_mse <- mean((pls_pred - test$crim)^2)
pls_mse
## [1] 21.57916
results <- data.frame(
  Method = c("OLS", "Ridge", "Lasso", "PCR", "PLS"),
  Test_MSE = c(lm_mse, 21.21518, 21.42649, 21.28369, pls_mse)
)

results$RMSE <- round(sqrt(results$Test_MSE), 4)
results
##   Method Test_MSE   RMSE
## 1    OLS 22.57552 4.7514
## 2  Ridge 21.21518 4.6060
## 3  Lasso 21.42649 4.6289
## 4    PCR 21.28369 4.6134
## 5    PLS 21.57916 4.6453

##a & b RMSE is lowest in ridge by a hundredth. All models are extremely similar in RMSE. OLS is the worst model, likely because it has higher variance. The other models reduce variance more than they add bias. Ridge has the lowest RMSE, this is the best model.

##c The chosen model includes all 13 features because this version of the model had the lowest RMSE.