STA-6543: Assignment 5
Austin Thrash - FFK221
2024-03-21
Table of Contents:
2. For parts (a) through (c), indicate which of i. through iv. is correct. Justify your answer.
2.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.
Lasso regression introduces bias by penalizing the absolute values of coefficients, this reduces the flexibility of the model when compared to least squares. By shrinking the coefficients, lasso regression reduces the variance of the model and thus improves the overall prediction accuracy.
2.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.
Similar to Lasso, Ridge regression introduces bias by penalizing the square of coefficients and reduces variance by shrinking coefficients towards zero, which helps prevent overfitting. Ridge regression trades off increased bias for reduced variance, which in turn improves the prediction accuracy.
2.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.
Non-linear methods can capture complex relationships between the predictors and the response variable, this flexibility in non-linear methods can lead to lower bias compared to linear models. However this flexibility can lead to higher variance especially if the dataset is small. Overall, non-linear methods trade off increased variance for reduced bias.
9. In this exercise, we will predict the number of applications received using the other variables in the College data set.
9.a
Split the data set into a training set and a test set.
set.seed(1)
train <- sample(nrow(College),nrow(College)*0.7)
model.train <- College[train,]
model.test <- College[-train,]9.b
Fit a linear model using least squares on the training set, and report the test error obtained.
linearModel <- lm(Apps ~ ., data = model.train)
summary(linearModel)##
## Call:
## lm(formula = Apps ~ ., data = model.train)
##
## Residuals:
## Min 1Q Median 3Q Max
## -5816.1 -451.6 -1.0 327.2 7445.9
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) -5.377e+02 5.076e+02 -1.059 0.28995
## PrivateYes -5.045e+02 1.648e+02 -3.061 0.00232 **
## Accept 1.722e+00 4.763e-02 36.159 < 2e-16 ***
## Enroll -1.055e+00 2.437e-01 -4.329 1.80e-05 ***
## Top10perc 5.358e+01 6.440e+00 8.320 7.64e-16 ***
## Top25perc -1.614e+01 5.092e+00 -3.170 0.00161 **
## F.Undergrad 2.970e-02 4.399e-02 0.675 0.49976
## P.Undergrad 7.162e-02 3.649e-02 1.963 0.05019 .
## Outstate -8.841e-02 2.176e-02 -4.064 5.57e-05 ***
## Room.Board 1.630e-01 5.577e-02 2.923 0.00362 **
## Books 2.727e-01 2.723e-01 1.001 0.31715
## Personal -7.316e-03 7.283e-02 -0.100 0.92002
## PhD -9.676e+00 5.360e+00 -1.805 0.07161 .
## Terminal -3.781e-01 6.015e+00 -0.063 0.94990
## S.F.Ratio 1.627e+01 1.608e+01 1.012 0.31214
## perc.alumni 2.358e+00 4.853e+00 0.486 0.62722
## Expend 5.986e-02 1.337e-02 4.476 9.34e-06 ***
## Grad.Rate 7.158e+00 3.520e+00 2.034 0.04248 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 1022 on 525 degrees of freedom
## Multiple R-squared: 0.9332, Adjusted R-squared: 0.9311
## F-statistic: 431.6 on 17 and 525 DF, p-value: < 2.2e-16predictions <- predict(linearModel,model.test)
lm_mse <- mean((predictions - model.test$Apps)^2)
cat("Test Error (MSE): ", lm_mse, "\n")## Test Error (MSE): 12616309.c
Fit a ridge regression model on the training set, with λ chosen by cross-validation. Report the test error obtained.
train.mtx <- model.matrix(Apps ~ ., data = model.train)
test.mtx <- model.matrix(Apps ~ ., data = model.test)
grid <- 10 ^ seq(4, -2, length = 100)
ridge_fit <- glmnet(train.mtx, model.train$Apps, alpha = 0, lambda = grid)
ridge_cv <- cv.glmnet(train.mtx, model.train$Apps, alpha = 0, lambda = grid)
bestlam.ridge <- ridge_cv$lambda.min
cat("Best Lambda: ", bestlam.ridge, "\n")## Best Lambda: 0.01predictions_ridge <- predict(ridge_fit, s = bestlam.ridge, newx = test.mtx)
ridge_mse <- mean((predictions_ridge - model.test$Apps)^2)
cat("Test Error (MSE): ",ridge_mse , "\n")## Test Error (MSE): 12615309.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.
lasso_fit <- glmnet(train.mtx, model.train$Apps, alpha = 1, lambda = grid)
lasso_cv <- cv.glmnet(train.mtx, model.train$Apps, alpha = 1, lambda = grid)
bestlam.lasso <- lasso_cv$lambda.min
cat("Best Lambda: ", bestlam.lasso, "\n")## Best Lambda: 0.01predictions_lasso <- predict(lasso_fit, s = bestlam.lasso, newx = test.mtx)
lasso_mse <- mean((predictions_lasso - model.test$Apps)^2)
cat("Test Error (MSE): ",lasso_mse , "\n")## Test Error (MSE): 1261265lasso_coef <- predict(lasso_fit, type = "coefficients", s = lasso_cv$lambda.min)
round(lasso_coef, 3)## 19 x 1 sparse Matrix of class "dgCMatrix"
## s1
## (Intercept) -538.438
## (Intercept) .
## PrivateYes -504.527
## Accept 1.722
## Enroll -1.048
## Top10perc 53.561
## Top25perc -16.129
## F.Undergrad 0.029
## P.Undergrad 0.072
## Outstate -0.088
## Room.Board 0.163
## Books 0.272
## Personal -0.007
## PhD -9.679
## Terminal -0.367
## S.F.Ratio 16.256
## perc.alumni 2.340
## Expend 0.060
## Grad.Rate 7.15618 of the 19 coefficients are non-zero.
9.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.
# Unsure if I am doing this correctly
pcr_fit <- pcr(Apps ~ ., data = model.train, scale = TRUE, validation = "CV")
# Creating Validation Plot that shows cross-validation scores, page 280
validationplot(pcr_fit, val.type = "MSEP")
predictions_pcr <- predict(pcr_fit, model.test, ncomp = 10)
pcr_mse <- mean((predictions_pcr - model.test$Apps)^2)
cat("Test Error (MSE): ",pcr_mse , "\n")## Test Error (MSE): 18372039.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 select by cross-validation.
pls_fit <- plsr(Apps ~ ., data = model.train, scale = TRUE, validation = "CV")
validationplot(pls_fit, val.type = "MSEP")
predictions_pls <- predict(pls_fit, model.test, ncomp = 10)
pls_mse <- mean((predictions_pls - model.test$Apps)^2)
cat("Test Error (MSE): ",pls_mse , "\n")## Test Error (MSE): 12793539.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?
# R^2 = 1 - RSS/TSS
test_avg <- mean(model.test$Apps)
# We can just use the summary feature to get the linear models R-Squared
lm_summary <- summary(linearModel)
lm_r2 <- lm_summary$r.squared
ridge_r2 <- 1 - mean((predictions_ridge - model.test$Apps)^2) / mean((test_avg - model.test$Apps)^2)
lasso_r2 <- 1 - mean((predictions_lasso - model.test$Apps)^2) / mean((test_avg - model.test$Apps)^2)
pcr_r2 <- 1 - mean((predictions_pcr - model.test$Apps)^2) / mean((test_avg - model.test$Apps)^2)
pls_r2 <- 1 - mean((predictions_pls - model.test$Apps)^2) / mean((test_avg - model.test$Apps)^2)
cat("Linear Model - R-Squared: ", lm_r2, " MSE: ", lm_mse, "\n")## Linear Model - R-Squared: 0.9332181 MSE: 1261630cat("Ridge Model - R-Squared: ", ridge_r2, " MSE: ", ridge_mse,"\n")## Ridge Model - R-Squared: 0.9134527 MSE: 1261530cat("Lasso Model - R-Squared: ", lasso_r2, " MSE: ", lasso_mse,"\n")## Lasso Model - R-Squared: 0.9134709 MSE: 1261265cat("PCR Model - R-Squared: ", pcr_r2, " MSE: ", pcr_mse,"\n")## PCR Model - R-Squared: 0.8739587 MSE: 1837203cat("PLS Model - R-Squared: ", pls_r2, " MSE: ", pls_mse,"\n")## PLS Model - R-Squared: 0.9122299 MSE: 1279353All models except for PCR seem to be able to predict the number of applications with at least 90% accuracy. PCR has the worst accuracy at 87.4%, it also has a much larger test error (MSE). There is not much difference when it comes to test error when comparing the rest of the models, excluding PCR, the largest difference between test errors is about 10000 with the smallest difference being 7 (Ridge and Lasso).