Question 2

  1. False. Lasso is less flexible due to how it penalizes coefficients
  2. False. Again, lasso is less flexible due to how it penalizes coefficients.
  3. True. Lasso does lead to greater prediction power as it reduces variance more than it increases bias.
  4. False. Lasso does not increase variance, it decreases it.
  1. False. Ridge is also less flexible than OLS.
  2. False. Again, ridge is less flexible than OLS.
  3. True. Ridge does decrease variance while slightly increasing bias.
  4. False. Ridge does not increase variance.
  1. True. Non-linear methods are more flexible and lower bias while increasing variance.
  2. True, I think. Non-linear methods are more flexible and I think this is just reversing the previous statement about the bias/variance trade-off.
  3. False. Non-linear methods are more flexible, not less.
  4. False. Non-linear methods are more flexible, not less.

Question 9

  1. See below.
set.seed(1)
college <- College
college$Private <- ifelse(college$Private == "Yes", 1, 0)

college_split <- initial_split(college, prop = 0.7)
college_train <- training(college_split)
college_test  <- testing(college_split)
  1. The root mean square error is 959, meaning that the linear model’s predictions are off by about 959 applications received.
## [1] 1123.223
  1. The RMSE for this model came out at 895, meaning that the predictions on average are off by about 895 received applications.
## [1] 1058.789
  1. The RMSE for this model came out at 891.5, meaning that the predictions on average are off by about 891.5 received applications.
## [1] 1099.201
  1. The RMSE for this model came out at 958.8, meaning that the predictions on average are off by about 958.8 received applications. The value of M selected via cross validation was 17.
## [1] 1123.223
## [1] 17
  1. The RMSE for this model also came out at 1123, meaning that the predictions on average are off by about 1123 received applications. The value of M selected via cross validation was also 17 for this model.
## Selected M = 17
## [1] 1123.223
## 17 comps 
##       17
  1. Given the similar values for RMSE obtained across models, I think it’s hard for us to predict the number of applications received. Given that the mean number of applications received is 3,002, only being able to predict within ~900 applications isn’t very helpful. However, I think that this is a poor dependent variable and that it doesn’t make theoretical sense to predict for it using the variables that we have. I think better predictors would be things like cost, prestige, et cetera. In sum, there isn’t much difference among these models for this particular dataset.

Question 11

  1. The ridge model’s RMSE is 7.6, meaning the model can predict the per capita crime rate accurately for each town within 7.6 units. Lasso produced virtually the same result. After conducting the best subset selection, I removed “age” from the model and performed a regular linear regression, which still performed about the same as the lasso and ridge models. The PCR and PLS models also produced a similar RMSE, though slightly better than the others.
set.seed(1)

boston <- Boston

boston_split <- initial_split(boston, prop = 0.7)
boston_train <- training(boston_split)
boston_test  <- testing(boston_split)

boston_folds <- vfold_cv(boston, v = 10)

ridge_spec <- linear_reg(penalty = tune(), mixture = 0) %>%
  set_engine("glmnet")

boston_recipe <- recipe(crim ~ ., data = boston) %>%
  step_normalize(all_predictors())

ridge_wf <- workflow() %>%
  add_recipe(boston_recipe) %>%
  add_model(ridge_spec)

penalty_grid <- grid_regular(penalty(range = c(-4, 2)), levels = 100)

ridge_results <- tune_grid(
  ridge_wf,
  resamples = boston_folds,
  grid = penalty_grid,
  metrics = metric_set(yardstick::rmse, yardstick::rsq, yardstick::mae)
)

best_ridge <- select_best(ridge_results, metric = "rmse")

ridge_cv_metrics <- collect_metrics(ridge_results) %>%
  filter(penalty == best_ridge$penalty) %>%
  select(metric = .metric, estimate = mean) %>%
  mutate(model = "Ridge Regression")

final_ridge_wf <- finalize_workflow(ridge_wf, best_ridge)

final_ridge_fit <- fit(final_ridge_wf, data = boston_train)

ridge_test_pred <- predict(final_ridge_fit, new_data = boston_test)

ridge_test_error <- mean((boston_test$crim - ridge_test_pred$.pred)^2)
sqrt(ridge_test_error)
## [1] 7.664965
set.seed(1)

lasso_spec <- linear_reg(penalty = tune(), mixture = 1) %>%
  set_engine("glmnet")

lasso_wf <- workflow() %>%
  add_recipe(boston_recipe) %>%
  add_model(lasso_spec)

penalty_grid <- grid_regular(penalty(range = c(-4, 2)), levels = 100)

lasso_results <- tune_grid(
  lasso_wf,
  resamples = boston_folds,
  grid = penalty_grid,
  metrics = metric_set(yardstick::rmse, yardstick::rsq, yardstick::mae)
)
## → A | warning: A correlation computation is required, but `estimate` is constant and has 0
##                standard deviation, resulting in a divide by 0 error. `NA` will be returned.
## There were issues with some computations   A: x22There were issues with some computations   A: x43There were issues with some computations   A: x64There were issues with some computations   A: x85There were issues with some computations   A: x106There were issues with some computations   A: x127There were issues with some computations   A: x149There were issues with some computations   A: x171There were issues with some computations   A: x193There were issues with some computations   A: x214There were issues with some computations   A: x214
best_lasso <- select_best(lasso_results, metric = "rmse")

lasso_cv_metrics <- collect_metrics(lasso_results) %>%
  filter(penalty == best_lasso$penalty) %>%
  select(metric = .metric, estimate = mean) %>%
  mutate(model = "Lasso Regression")

final_lasso_wf <- finalize_workflow(lasso_wf, best_lasso)

final_lasso_fit <- fit(final_lasso_wf, data = boston_train)

lasso_test_pred <- predict(final_lasso_fit, new_data = boston_test)

lasso_test_error <- mean((boston_test$crim - lasso_test_pred$.pred)^2)
sqrt(lasso_test_error)
## [1] 7.666177
## Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
## ℹ Please use `linewidth` instead.
## This warning is displayed once per session.
## Call `lifecycle::last_lifecycle_warnings()` to see where this warning was
## generated.
lm_model <- lm(crim ~ zn + tax + rm + rad + ptratio + nox + medv + lstat + indus + dis + chas, data=boston_train)

boston_prediction <- predict(lm_model, newdata = boston_test)

test_error <- mean((boston_test$crim - boston_prediction)^2)
sqrt(test_error)
## [1] 7.590427
set.seed(1)

pcr_spec <- linear_reg() %>%
  set_engine("lm")

boston_recipe_pcr <- recipe(crim ~ ., data = boston_train) %>%
  step_dummy(all_nominal_predictors()) %>%
  step_normalize(all_numeric_predictors()) %>%
  step_pca(all_predictors(), num_comp = tune())

pcr_wf <- workflow() %>%
  add_recipe(boston_recipe_pcr) %>%
  add_model(pcr_spec)

pcr_grid <- grid_regular(num_comp(range = c(1, 20)), levels = 20)

pcr_results <- tune_grid(
  pcr_wf,
  resamples = boston_folds,
  grid = pcr_grid,
  metrics = metric_set(yardstick::rmse)
)

best_pcr <- select_best(pcr_results, metric = "rmse")

final_pcr_wf <- finalize_workflow(pcr_wf, best_pcr)

final_pcr_fit <- fit(final_pcr_wf, data = boston_train)

pcr_test_pred <- predict(final_pcr_fit, new_data = boston_test)

pcr_test_mse <- mean((boston_test$crim - pcr_test_pred$.pred)^2)
sqrt(pcr_test_mse)
## [1] 7.590291
set.seed(1)

pls_fit <- plsr(
  crim ~ ., 
  data = boston_train,
  scale = TRUE,
  validation = "CV"
)

rm <- RMSEP(pls_fit)$val[1,,]

M <- which.min(rm) - 1

max_comps <- pls_fit$ncomp
if (M > max_comps) M <- max_comps

cat("Selected M =", M, "\n")
## Selected M = 10
pls_pred <- predict(pls_fit, newdata = boston_test, ncomp = M)

pls_test_mse <- mean((boston_test$crim - pls_pred)^2)
sqrt(pls_test_mse)
## [1] 7.590268

  1. Given the results above, I would propose to stick with PCR and PLS models for this dataset.

  2. These models do include all variables in the datset, which (from what I have read) is the norm for PCR and PLS given that they can account for such noise in the model.