{ "cells": [ { "cell_type": "code", "execution_count": null, "id": "b0194168", "metadata": { "name": "setup", "tags": [ "remove_input" ] }, "outputs": [], "source": [ "knitr::opts_chunk$set(error = TRUE)" ] }, { "cell_type": "markdown", "id": "ddd06bad", "metadata": {}, "source": [ "# Linear Models and Regularization Methods\n", "## Subset Selection Methods\n", "\n", "### Best Subset Selection" ] }, { "cell_type": "markdown", "id": "587de2f5", "metadata": {}, "source": [ "Here we apply the best subset selection approach to the `Hitters` data.\n", "We wish to predict a baseball player's `Salary` on the basis of various statistics associated with performance in the previous year.\n", "\n", "First of all, we note that the `Salary` variable is missing for some of the players. The `is.na()` function can be used to identify the missing observations. It returns a vector of the same length as the input vector, with a `TRUE` for any elements that are missing, and a `FALSE` for non-missing elements.\n", " The `sum()` function can then be used to count all of the missing elements." ] }, { "cell_type": "code", "execution_count": null, "id": "21433ee4", "metadata": { "name": "chunk1" }, "outputs": [], "source": [ "library(ISLR2)\n", "names(Hitters)\n", "dim(Hitters)\n", "sum(is.na(Hitters$Salary))" ] }, { "cell_type": "markdown", "id": "6c8b03bc", "metadata": {}, "source": [ "Hence we see that `Salary` is missing for $59$ players. The `na.omit()` function removes all of the rows that have missing values in any variable." ] }, { "cell_type": "code", "execution_count": null, "id": "16606837", "metadata": { "lines_to_next_cell": 2, "name": "chunk2" }, "outputs": [], "source": [ "Hitters <- na.omit(Hitters)\n", "dim(Hitters)\n", "sum(is.na(Hitters))" ] }, { "cell_type": "markdown", "id": "3fa276de", "metadata": {}, "source": [ "The `regsubsets()` function (part of the `leaps` library) performs best subset selection by identifying the best model that contains a given number of predictors, where *best* is quantified using RSS. The syntax is the same as for `lm()`. The `summary()` command outputs the best set of variables for each model size." ] }, { "cell_type": "code", "execution_count": null, "id": "27ef6c01", "metadata": { "name": "chunk3" }, "outputs": [], "source": [ "library(leaps)\n", "regfit.full <- regsubsets(Salary ~ ., Hitters)\n", "summary(regfit.full)" ] }, { "cell_type": "markdown", "id": "c68b1dc9", "metadata": {}, "source": [ "An asterisk indicates that a given variable is included in the corresponding model.\n", "For instance, this output indicates that the best two-variable model contains only `Hits` and `CRBI`.\n", "By default, `regsubsets()` only reports results up to the best eight-variable model. But the `nvmax` option can be used in order to return as many variables as are desired. Here we fit up to a 19-variable model." ] }, { "cell_type": "code", "execution_count": null, "id": "d2ad4a84", "metadata": { "lines_to_next_cell": 2, "name": "chunk4" }, "outputs": [], "source": [ "regfit.full <- regsubsets(Salary ~ ., data = Hitters,\n", " nvmax = 19)\n", "reg.summary <- summary(regfit.full)" ] }, { "cell_type": "markdown", "id": "70d681c2", "metadata": {}, "source": [ "The `summary()` function also returns $R^2$, RSS, adjusted $R^2$, $C_p$, and BIC. We can examine these to try to select the *best* overall model." ] }, { "cell_type": "code", "execution_count": null, "id": "73b86a17", "metadata": { "name": "chunk5" }, "outputs": [], "source": [ "names(reg.summary)" ] }, { "cell_type": "markdown", "id": "629149c6", "metadata": {}, "source": [ "For instance, we see that the $R^2$ statistic increases from $32 \\%$, when only one variable is included in the model, to almost $55 \\%$, when all variables are included. As expected, the $R^2$ statistic increases monotonically as more variables are included." ] }, { "cell_type": "code", "execution_count": null, "id": "fbe02b10", "metadata": { "name": "chunk6" }, "outputs": [], "source": [ "reg.summary$rsq" ] }, { "cell_type": "markdown", "id": "f50d7269", "metadata": {}, "source": [ "Plotting RSS, adjusted $R^2$, $C_p$, and BIC for all of the models at once will help us decide which model to select. Note the `type = \"l\"` option tells `R` to connect the plotted points with lines." ] }, { "cell_type": "code", "execution_count": null, "id": "1f747fdd", "metadata": { "name": "chunk7" }, "outputs": [], "source": [ "par(mfrow = c(2, 2))\n", "plot(reg.summary$rss, xlab = \"Number of Variables\",\n", " ylab = \"RSS\", type = \"l\")\n", "plot(reg.summary$adjr2, xlab = \"Number of Variables\",\n", " ylab = \"Adjusted RSq\", type = \"l\")" ] }, { "cell_type": "markdown", "id": "5d1531f4", "metadata": {}, "source": [ "The `points()` command works like the `plot()` command, except that it puts points on a plot that has already been created, instead of creating a new plot. The `which.max()` function can be used to identify the location of the maximum point of a vector. We will now plot a red dot to indicate the model with the largest adjusted $R^2$ statistic." ] }, { "cell_type": "code", "execution_count": null, "id": "ee6cb59b", "metadata": { "name": "chunk8" }, "outputs": [], "source": [ "which.max(reg.summary$adjr2)\n", "plot(reg.summary$adjr2, xlab = \"Number of Variables\",\n", " ylab = \"Adjusted RSq\", type = \"l\")\n", "points(11, reg.summary$adjr2[11], col = \"red\", cex = 2, \n", " pch = 20)" ] }, { "cell_type": "markdown", "id": "ac33fef5", "metadata": {}, "source": [ "In a similar fashion we can plot the $C_p$ and BIC statistics, and indicate the models with the smallest statistic using `which.min()`." ] }, { "cell_type": "code", "execution_count": null, "id": "e106205a", "metadata": { "lines_to_next_cell": 2, "name": "chunk9" }, "outputs": [], "source": [ "plot(reg.summary$cp, xlab = \"Number of Variables\",\n", " ylab = \"Cp\", type = \"l\")\n", "which.min(reg.summary$cp)\n", "points(10, reg.summary$cp[10], col = \"red\", cex = 2,\n", " pch = 20)\n", "which.min(reg.summary$bic)\n", "plot(reg.summary$bic, xlab = \"Number of Variables\",\n", " ylab = \"BIC\", type = \"l\")\n", "points(6, reg.summary$bic[6], col = \"red\", cex = 2,\n", " pch = 20)" ] }, { "cell_type": "markdown", "id": "e1459e33", "metadata": {}, "source": [ "The `regsubsets()` function has a built-in `plot()` command which can be used to display the selected variables for the best model with a given number of predictors, ranked according to the BIC, $C_p$, adjusted $R^2$, or AIC.\n", "To find out more about this function, type `?plot.regsubsets`." ] }, { "cell_type": "code", "execution_count": null, "id": "97f26470", "metadata": { "name": "chunk10" }, "outputs": [], "source": [ "plot(regfit.full, scale = \"r2\")\n", "plot(regfit.full, scale = \"adjr2\")\n", "plot(regfit.full, scale = \"Cp\")\n", "plot(regfit.full, scale = \"bic\")" ] }, { "cell_type": "markdown", "id": "2b673418", "metadata": {}, "source": [ "The top row of each plot contains a black square for each variable selected according to the optimal model associated with that statistic. For instance, we see that several models share a BIC close to $-150$. However, the model with the lowest BIC is the six-variable model that contains only `AtBat`,\n", "`Hits`, `Walks`, `CRBI`, `DivisionW`, and `PutOuts`.\n", "We can use the `coef()` function to see the coefficient estimates associated with this model." ] }, { "cell_type": "code", "execution_count": null, "id": "427d05f4", "metadata": { "lines_to_next_cell": 0, "name": "chunk11" }, "outputs": [], "source": [ "coef(regfit.full, 6)" ] }, { "cell_type": "markdown", "id": "bc386134", "metadata": {}, "source": [ "\n", "\n" ] }, { "cell_type": "markdown", "id": "434b7ab1", "metadata": {}, "source": [ "### Forward and Backward Stepwise Selection\n" ] }, { "cell_type": "markdown", "id": "68c736bf", "metadata": {}, "source": [ "We can also use the `regsubsets()` function to perform forward stepwise or backward stepwise selection, using the argument `method = \"forward\"`\n", "or `method = \"backward\"`." ] }, { "cell_type": "code", "execution_count": null, "id": "916cb15a", "metadata": { "name": "chunk12" }, "outputs": [], "source": [ "regfit.fwd <- regsubsets(Salary ~ ., data = Hitters,\n", " nvmax = 19, method = \"forward\")\n", "summary(regfit.fwd)\n", "regfit.bwd <- regsubsets(Salary ~ ., data = Hitters,\n", " nvmax = 19, method = \"backward\")\n", "summary(regfit.bwd)" ] }, { "cell_type": "markdown", "id": "9fb3dd74", "metadata": {}, "source": [ "For instance, we see that using forward stepwise selection, the best one-variable model contains only `CRBI`, and the best two-variable model additionally includes `Hits`. For this data, the best one-variable through six-variable models are each identical for best subset and forward selection. However, the best seven-variable models identified by forward stepwise selection, backward stepwise selection, and best subset selection are different." ] }, { "cell_type": "code", "execution_count": null, "id": "6f3aa0fb", "metadata": { "lines_to_next_cell": 0, "name": "chunk13" }, "outputs": [], "source": [ "coef(regfit.full, 7)\n", "coef(regfit.fwd, 7)\n", "coef(regfit.bwd, 7)" ] }, { "cell_type": "markdown", "id": "1f68cc28", "metadata": {}, "source": [ "\n", "\n" ] }, { "cell_type": "markdown", "id": "cda844a7", "metadata": {}, "source": [ "### Choosing Among Models Using the Validation-Set Approach and Cross-Validation" ] }, { "cell_type": "markdown", "id": "d3b85250", "metadata": {}, "source": [ "We just saw that it is possible to choose among a set of models of different sizes using $C_p$, BIC, and adjusted $R^2$. We will now consider how to do this using the\n", "validation set and cross-validation approaches.\n", "\n", "In order for these approaches to yield accurate estimates of the test\n", "error, we must use *only the training observations* to perform all aspects of model-fitting---including variable\n", " selection. Therefore, the determination of which model of a\n", "given size is best must be made using *only the training observations*. This point is subtle but important.\n", "If the full data set is used to perform the best subset selection\n", "step, the validation set errors and cross-validation errors that we\n", "obtain will not be accurate estimates of the test error.\n", "\n", "In order to use the validation set approach, we begin by splitting the\n", "observations into a training set and a test set. We do this by creating a\n", "random vector, `train`, of elements equal to `TRUE` if the\n", "corresponding observation is in the training set, and `FALSE`\n", "otherwise. The vector `test` has a `TRUE` if the\n", "observation is in the test set, and a `FALSE` otherwise. Note\n", "the `!` in the command to create `test` causes `TRUE`s to be\n", "switched to `FALSE`s and vice versa. We also set a random seed\n", "so that the user will obtain the same training set/test set split." ] }, { "cell_type": "code", "execution_count": null, "id": "081cdd96", "metadata": { "name": "chunk14" }, "outputs": [], "source": [ "set.seed(1)\n", "train <- sample(c(TRUE, FALSE), nrow(Hitters),\n", " replace = TRUE)\n", "test <- (!train)" ] }, { "cell_type": "markdown", "id": "6a2d7713", "metadata": {}, "source": [ "Now, we apply `regsubsets()` to the training set in order to perform best subset selection." ] }, { "cell_type": "code", "execution_count": null, "id": "6af7472c", "metadata": { "name": "chunk15" }, "outputs": [], "source": [ "regfit.best <- regsubsets(Salary ~ .,\n", " data = Hitters[train, ], nvmax = 19)" ] }, { "cell_type": "markdown", "id": "225777b9", "metadata": {}, "source": [ "Notice that we subset the `Hitters` data frame directly in the call in order to access only the training subset of the data, using the expression `Hitters[train, ]`.\n", "We now compute the validation set error for the best model of each model size. We first make a model matrix\n", "from the test data." ] }, { "cell_type": "code", "execution_count": null, "id": "b1b09c19", "metadata": { "name": "chunk16" }, "outputs": [], "source": [ "test.mat <- model.matrix(Salary ~ ., data = Hitters[test, ])" ] }, { "cell_type": "markdown", "id": "57f2ceb6", "metadata": {}, "source": [ "The\n", "`model.matrix()` function is used in many regression\n", "packages for building an \"X\" matrix from data. Now we run a loop,\n", "and for each size `i`, we extract the coefficients from\n", "`regfit.best` for the best model of that size, multiply them into\n", "the appropriate columns of the test model matrix to form the\n", "predictions, and compute the test MSE." ] }, { "cell_type": "code", "execution_count": null, "id": "31c637c5", "metadata": { "name": "chunk17" }, "outputs": [], "source": [ "val.errors <- rep(NA, 19)\n", "for (i in 1:19) {\n", " coefi <- coef(regfit.best, id = i)\n", " pred <- test.mat[, names(coefi)] %*% coefi\n", " val.errors[i] <- mean((Hitters$Salary[test] - pred)^2)\n", "}" ] }, { "cell_type": "markdown", "id": "efe06bff", "metadata": {}, "source": [ "We find that the best model is the one that contains seven variables." ] }, { "cell_type": "code", "execution_count": null, "id": "dd025bb2", "metadata": { "lines_to_next_cell": 2, "name": "chunk18" }, "outputs": [], "source": [ "val.errors\n", "which.min(val.errors)\n", "coef(regfit.best, 7)" ] }, { "cell_type": "markdown", "id": "9767bfdc", "metadata": {}, "source": [ "This was a little tedious, partly because there is no `predict()` method for `regsubsets()`.\n", "Since we will be using this function again, we can capture our steps above and write our own predict method.\n" ] }, { "cell_type": "code", "execution_count": null, "id": "7dc0565f", "metadata": { "name": "chunk19" }, "outputs": [], "source": [ " predict.regsubsets <- function(object, newdata, id, ...) {\n", " form <- as.formula(object$call[[2]])\n", " mat <- model.matrix(form, newdata)\n", " coefi <- coef(object, id = id)\n", " xvars <- names(coefi)\n", " mat[, xvars] %*% coefi\n", " }" ] }, { "cell_type": "markdown", "id": "99615596", "metadata": {}, "source": [ "Our function pretty much mimics what we did above. The only complex part is how we extracted the formula used in\n", "the call to `regsubsets()`. We demonstrate how we use this function below, when we do cross-validation.\n", "\n", "Finally, we perform best subset selection on the full data set, and select the best seven-variable model. It is important that we make use of the full data set in order to obtain more accurate coefficient estimates. Note that we perform best subset selection on the full data set and select the best seven-variable model, rather than simply using the variables that were obtained from the training set, because the best seven-variable model on the full data set may differ from the corresponding model on the training set." ] }, { "cell_type": "code", "execution_count": null, "id": "2d2088a2", "metadata": { "name": "chunk20" }, "outputs": [], "source": [ "regfit.best <- regsubsets(Salary ~ ., data = Hitters,\n", " nvmax = 19)\n", "coef(regfit.best, 7)" ] }, { "cell_type": "markdown", "id": "66ff7099", "metadata": {}, "source": [ "In fact, we see that the best seven-variable model on the full data set has a different set of variables than the best seven-variable model on the training set.\n", "\n", "We now try to choose among the models of different sizes using cross-validation.\n", "This approach is somewhat involved, as we must perform best subset selection *within each of the $k$ training sets*.\n", "Despite this, we see that with its clever subsetting syntax, `R` makes this job quite easy.\n", " First, we create a vector that allocates each observation to one of $k=10$ folds, and we create\n", "a matrix in which we will store the results." ] }, { "cell_type": "code", "execution_count": null, "id": "0a33aa52", "metadata": { "name": "chunk21" }, "outputs": [], "source": [ "k <- 10\n", "n <- nrow(Hitters)\n", "set.seed(1)\n", "folds <- sample(rep(1:k, length = n))\n", "cv.errors <- matrix(NA, k, 19,\n", " dimnames = list(NULL, paste(1:19)))" ] }, { "cell_type": "markdown", "id": "f11b779c", "metadata": {}, "source": [ "Now we write a for loop that performs cross-validation. In the $j$th fold, the elements of `folds` that equal `j` are in the test set, and the remainder are in the training set. We make our predictions for each model size (using our new\n", "`predict()` method), compute the test errors on the appropriate subset, and\n", "store them in the appropriate slot in the matrix `cv.errors`. Note that in the following code `R` will automatically use our `predict.regsubsets()` function when we call `predict()` because the `best.fit` object has class `regsubsets`." ] }, { "cell_type": "code", "execution_count": null, "id": "d6623cde", "metadata": { "name": "chunk22" }, "outputs": [], "source": [ "for (j in 1:k) {\n", " best.fit <- regsubsets(Salary ~ .,\n", " data = Hitters[folds != j, ],\n", " nvmax = 19)\n", " for (i in 1:19) {\n", " pred <- predict(best.fit, Hitters[folds == j, ], id = i)\n", " cv.errors[j, i] <-\n", " mean((Hitters$Salary[folds == j] - pred)^2)\n", " }\n", " }" ] }, { "cell_type": "markdown", "id": "139f0fa6", "metadata": {}, "source": [ "This has given us a $10 \\times 19$ matrix, of which the $(j,i)$th element corresponds to the test MSE for the $j$th\n", "cross-validation fold for the best $i$-variable model. We use the `apply()` function to average over the columns of this matrix in order to obtain a vector for which the $i$th element is the cross-validation error for the $i$-variable model." ] }, { "cell_type": "code", "execution_count": null, "id": "b5ddbf70", "metadata": { "name": "chunk23" }, "outputs": [], "source": [ "mean.cv.errors <- apply(cv.errors, 2, mean)\n", "mean.cv.errors\n", "par(mfrow = c(1, 1))\n", "plot(mean.cv.errors, type = \"b\")" ] }, { "cell_type": "markdown", "id": "540179ee", "metadata": {}, "source": [ "We see that cross-validation selects a 10-variable model. We now perform best subset selection on the full data set in order to obtain the 10-variable model." ] }, { "cell_type": "code", "execution_count": null, "id": "f4cdcc57", "metadata": { "lines_to_next_cell": 0, "name": "chunk24" }, "outputs": [], "source": [ "reg.best <- regsubsets(Salary ~ ., data = Hitters,\n", " nvmax = 19)\n", "coef(reg.best, 10)" ] }, { "cell_type": "markdown", "id": "42a5574d", "metadata": {}, "source": [ "\n" ] }, { "cell_type": "markdown", "id": "c5c18dea", "metadata": {}, "source": [ "## Ridge Regression and the Lasso\n", "\n", "We will use the `glmnet` package in order to perform ridge regression and the lasso.\n", "The main function in this package is `glmnet()`, which can be used to fit ridge regression models, lasso models, and more.\n", "This function has slightly different syntax from other model-fitting functions that we have encountered thus far in this book. In particular, we must pass in an `x` matrix as well as a `y` vector, and we do not use the `y ~ x` syntax. We will now perform ridge regression and the lasso in order to predict `Salary` on the `Hitters` data. Before proceeding ensure that the missing values have been removed from the data, as described in Section 6.5.1.\n" ] }, { "cell_type": "code", "execution_count": null, "id": "39682eed", "metadata": { "name": "chunk25" }, "outputs": [], "source": [ "x <- model.matrix(Salary ~ ., Hitters)[, -1]\n", "y <- Hitters$Salary" ] }, { "cell_type": "markdown", "id": "4894e68f", "metadata": {}, "source": [ "The `model.matrix()` function is particularly useful for creating `x`; not only does it produce a matrix corresponding to the $19$ predictors but it also automatically transforms any qualitative variables into dummy variables. The latter property is important because `glmnet()` can only take numerical, quantitative inputs.\n", "\n", "### Ridge Regression\n", "\n", "The `glmnet()` function has an `alpha` argument that determines what type of model is fit. If `alpha=0` then a ridge regression model is fit, and if `alpha=1`\n", "then a lasso model is fit. We first fit a ridge regression model." ] }, { "cell_type": "code", "execution_count": null, "id": "5cb34c48", "metadata": { "name": "chunk26" }, "outputs": [], "source": [ "library(glmnet)\n", "grid <- 10^seq(10, -2, length = 100)\n", "ridge.mod <- glmnet(x, y, alpha = 0, lambda = grid)" ] }, { "cell_type": "markdown", "id": "d3fc7a37", "metadata": {}, "source": [ "By default the `glmnet()` function performs ridge regression for an automatically selected range of $\\lambda$ values. However, here we have chosen to implement the function over a grid of values ranging from $\\lambda=10^{10}$ to $\\lambda=10^{-2}$, essentially covering the full range of scenarios from the null model containing only the intercept, to the least squares fit. As we will see, we can also compute model fits for a particular value of $\\lambda$ that is not one of the original `grid` values. Note that by default, the `glmnet()` function standardizes the variables so that they are on the same scale. To turn off this default setting, use the argument `standardize = FALSE`.\n", "\n", "Associated with each value of $\\lambda$ is a vector of ridge regression coefficients, stored in a matrix that can be accessed by `coef()`. In this case, it is a $20 \\times 100$\n", "matrix, with $20$ rows (one for each predictor, plus an intercept) and $100$ columns (one for each value of $\\lambda$)." ] }, { "cell_type": "code", "execution_count": null, "id": "74218772", "metadata": { "name": "chunk27" }, "outputs": [], "source": [ "dim(coef(ridge.mod))" ] }, { "cell_type": "markdown", "id": "16e5922e", "metadata": {}, "source": [ "We expect the coefficient estimates to be much smaller, in terms of $\\ell_2$ norm, when a large value of $\\lambda$ is used, as compared to when a small value of\n", "$\\lambda$ is used. These are the coefficients when $\\lambda=11{,}498$, along with their $\\ell_2$ norm:" ] }, { "cell_type": "code", "execution_count": null, "id": "2808f052", "metadata": { "name": "chunk28" }, "outputs": [], "source": [ "ridge.mod$lambda[50]\n", "coef(ridge.mod)[, 50]\n", "sqrt(sum(coef(ridge.mod)[-1, 50]^2))" ] }, { "cell_type": "markdown", "id": "13976013", "metadata": {}, "source": [ "In contrast, here are the coefficients when $\\lambda=705$, along with their $\\ell_2$ norm. Note the much larger $\\ell_2$ norm of the coefficients associated with this smaller value of $\\lambda$." ] }, { "cell_type": "code", "execution_count": null, "id": "04b469b6", "metadata": { "name": "chunk29" }, "outputs": [], "source": [ "ridge.mod$lambda[60]\n", "coef(ridge.mod)[, 60]\n", "sqrt(sum(coef(ridge.mod)[-1, 60]^2))" ] }, { "cell_type": "markdown", "id": "3e74d212", "metadata": {}, "source": [ "We can use the `predict()` function for a number of purposes. For instance, we can obtain the ridge regression coefficients for a new value of $\\lambda$, say $50$:" ] }, { "cell_type": "code", "execution_count": null, "id": "c30359af", "metadata": { "lines_to_next_cell": 2, "name": "chunk30" }, "outputs": [], "source": [ "predict(ridge.mod, s = 50, type = \"coefficients\")[1:20, ]" ] }, { "cell_type": "markdown", "id": "7e86e30b", "metadata": {}, "source": [ "We now split the samples into a training set and a test set in order to estimate the test error of ridge regression and the lasso. There are two common ways to randomly split a data set. The first is to produce a random vector of `TRUE`, `FALSE` elements and select the observations corresponding to `TRUE` for the training data. The second is to randomly choose a subset of numbers between $1$ and $n$; these can then be used as the indices for the training observations. The two approaches work equally well. We used the former method in Section 6.5.1. Here we demonstrate the latter approach.\n", "\n", "We first set a random seed so that the results obtained will be reproducible." ] }, { "cell_type": "code", "execution_count": null, "id": "5e830ed4", "metadata": { "name": "chunk31" }, "outputs": [], "source": [ "set.seed(1)\n", "train <- sample(1:nrow(x), nrow(x) / 2)\n", "test <- (-train)\n", "y.test <- y[test]" ] }, { "cell_type": "markdown", "id": "cc882c53", "metadata": {}, "source": [ "Next we fit a ridge regression model on the training set, and evaluate its MSE on the test set, using $\\lambda=4$. Note the use of the `predict()` function again. This time we get predictions for a test set, by replacing `type=\"coefficients\"` with the `newx` argument." ] }, { "cell_type": "code", "execution_count": null, "id": "7212ea80", "metadata": { "name": "chunk32" }, "outputs": [], "source": [ "ridge.mod <- glmnet(x[train, ], y[train], alpha = 0,\n", " lambda = grid, thresh = 1e-12)\n", "ridge.pred <- predict(ridge.mod, s = 4, newx = x[test, ])\n", "mean((ridge.pred - y.test)^2)" ] }, { "cell_type": "markdown", "id": "43a473de", "metadata": {}, "source": [ "The test MSE is $142{,}199$.\n", "Note that if we had instead simply fit a model with just an intercept, we would have predicted each test observation using the mean of the training observations. In that case, we could compute the test set MSE like this:" ] }, { "cell_type": "code", "execution_count": null, "id": "e6b072a6", "metadata": { "name": "chunk33" }, "outputs": [], "source": [ "mean((mean(y[train]) - y.test)^2)" ] }, { "cell_type": "markdown", "id": "e0ce75b3", "metadata": {}, "source": [ "We could also get the same result by fitting a ridge regression model with a *very* large value of $\\lambda$. Note that `1e10` means $10^{10}$." ] }, { "cell_type": "code", "execution_count": null, "id": "9df507f0", "metadata": { "name": "chunk34" }, "outputs": [], "source": [ "ridge.pred <- predict(ridge.mod, s = 1e10, newx = x[test, ])\n", "mean((ridge.pred - y.test)^2)" ] }, { "cell_type": "markdown", "id": "91511640", "metadata": {}, "source": [ "So fitting a ridge regression model with $\\lambda=4$ leads to a much lower test MSE than fitting a model with just an intercept.\n", "We now check whether there is any benefit to performing ridge regression with $\\lambda=4$ instead of just performing least squares regression. \n", "Recall that least squares is simply ridge regression with $\\lambda=0$. (In order for `glmnet()` to yield the exact least squares coefficients when $\\lambda=0$, we use the argument `exact = T` when calling the `predict()` function. Otherwise, the `predict()` function will interpolate over the grid of $\\lambda$ values used in fitting the `glmnet()` model, yielding approximate results. When we use `exact = T`, there remains a slight discrepancy in the third decimal place between the output of `glmnet()` when $\\lambda = 0$ and the output of `lm()`; this is due to numerical approximation on the part of `glmnet()`.)\n" ] }, { "cell_type": "code", "execution_count": null, "id": "06b693a9", "metadata": { "name": "chunk35" }, "outputs": [], "source": [ "ridge.pred <- predict(ridge.mod, s = 0, newx = x[test, ],\n", " exact = T, x = x[train, ], y = y[train])\n", "mean((ridge.pred - y.test)^2)\n", "lm(y ~ x, subset = train)\n", "predict(ridge.mod, s = 0, exact = T, type = \"coefficients\",\n", " x = x[train, ], y = y[train])[1:20, ]" ] }, { "cell_type": "markdown", "id": "68f9962e", "metadata": {}, "source": [ "In general, if we want to fit a (unpenalized) least squares model, then we should use the `lm()` function, since that function provides more useful outputs, such as standard errors and p-values for the coefficients.\n", "\n", "In general, instead of arbitrarily choosing $\\lambda=4$, it would be better to use cross-validation to choose the tuning parameter $\\lambda$.\n", "We can do this using the built-in cross-validation function, `cv.glmnet()`. By default, the function performs ten-fold cross-validation, though this can be changed using the argument `nfolds`. Note that we set a random seed first so our results will be reproducible, since the choice of the cross-validation folds is random." ] }, { "cell_type": "code", "execution_count": null, "id": "9a23e35b", "metadata": { "name": "chunk36" }, "outputs": [], "source": [ "set.seed(1)\n", "cv.out <- cv.glmnet(x[train, ], y[train], alpha = 0)\n", "plot(cv.out)\n", "bestlam <- cv.out$lambda.min\n", "bestlam" ] }, { "cell_type": "markdown", "id": "fea6a427", "metadata": {}, "source": [ "Therefore, we see that the value of $\\lambda$ that results in the smallest cross-validation error is $326$. What is the test MSE associated with this value of $\\lambda$?" ] }, { "cell_type": "code", "execution_count": null, "id": "06465339", "metadata": { "name": "chunk37" }, "outputs": [], "source": [ "ridge.pred <- predict(ridge.mod, s = bestlam,\n", " newx = x[test, ])\n", "mean((ridge.pred - y.test)^2)" ] }, { "cell_type": "markdown", "id": "db0e2b3d", "metadata": {}, "source": [ "This represents a further improvement over the test MSE that we got using $\\lambda=4$.\n", "Finally, we refit our ridge regression model on the full data set, using the value of $\\lambda$ chosen by cross-validation, and examine the coefficient estimates." ] }, { "cell_type": "code", "execution_count": null, "id": "9acf7236", "metadata": { "name": "chunk38" }, "outputs": [], "source": [ "out <- glmnet(x, y, alpha = 0)\n", "predict(out, type = \"coefficients\", s = bestlam)[1:20, ]" ] }, { "cell_type": "markdown", "id": "221468bc", "metadata": {}, "source": [ "As expected, none of the coefficients are zero---ridge regression does not perform variable selection!\n", "\n", "### The Lasso\n", "\n", "We saw that ridge regression with a wise choice of $\\lambda$ can outperform least squares as well as the null model on the `Hitters` data set. We now ask whether the lasso can yield either\n", "a more accurate or a more interpretable model than ridge regression. In order to fit a lasso model, we once again use the `glmnet()` function; however, this time we\n", "use the argument\n", "`alpha=1`. Other than that change, we proceed just as we did in fitting a ridge model." ] }, { "cell_type": "code", "execution_count": null, "id": "d48814cd", "metadata": { "name": "chunk39" }, "outputs": [], "source": [ "lasso.mod <- glmnet(x[train, ], y[train], alpha = 1,\n", " lambda = grid)\n", "plot(lasso.mod)" ] }, { "cell_type": "markdown", "id": "f42cd3a4", "metadata": {}, "source": [ "We can see from the coefficient plot that depending on the choice of tuning parameter, some of the coefficients will be exactly equal to zero.\n", "We now perform cross-validation and compute the associated test error." ] }, { "cell_type": "code", "execution_count": null, "id": "546d626c", "metadata": { "name": "chunk40" }, "outputs": [], "source": [ "set.seed(1)\n", "cv.out <- cv.glmnet(x[train, ], y[train], alpha = 1)\n", "plot(cv.out)\n", "bestlam <- cv.out$lambda.min\n", "lasso.pred <- predict(lasso.mod, s = bestlam,\n", " newx = x[test, ])\n", "mean((lasso.pred - y.test)^2)" ] }, { "cell_type": "markdown", "id": "306d89f2", "metadata": {}, "source": [ "This is substantially lower than the test set MSE of the null model and of least squares, and very similar to the test MSE of ridge regression with $\\lambda$ chosen by cross-validation.\n", "\n", "However, the lasso has a substantial advantage over ridge regression in that the resulting coefficient estimates are sparse. Here we see that 8 of the 19 coefficient estimates are exactly\n", "zero. So the lasso model with $\\lambda$ chosen by cross-validation contains only eleven variables." ] }, { "cell_type": "code", "execution_count": null, "id": "08a2e39f", "metadata": { "lines_to_next_cell": 0, "name": "chunk41" }, "outputs": [], "source": [ "out <- glmnet(x, y, alpha = 1, lambda = grid)\n", "lasso.coef <- predict(out, type = \"coefficients\",\n", " s = bestlam)[1:20, ]\n", "lasso.coef\n", "lasso.coef[lasso.coef != 0]" ] }, { "cell_type": "markdown", "id": "f8674004", "metadata": {}, "source": [] }, { "cell_type": "markdown", "id": "f1a380ba", "metadata": {}, "source": [ "## PCR and PLS Regression\n", "\n", "### Principal Components Regression" ] }, { "cell_type": "markdown", "id": "3202e581", "metadata": {}, "source": [ "Principal components regression (PCR) can be performed using the `pcr()` function, which is part of the `pls` library. We now apply PCR to the `Hitters` data, in order to predict `Salary`. Again,\n", " we ensure that the missing values have been removed from the data, as described in Section 6.5.1." ] }, { "cell_type": "code", "execution_count": null, "id": "3a86dd2a", "metadata": { "name": "chunk42" }, "outputs": [], "source": [ "library(pls)\n", "set.seed(2)\n", "pcr.fit <- pcr(Salary ~ ., data = Hitters, scale = TRUE,\n", " validation = \"CV\")" ] }, { "cell_type": "markdown", "id": "b3ca0b42", "metadata": {}, "source": [ "The syntax for the `pcr()` function is similar to that for `lm()`, with a few additional\n", "options. Setting `scale = TRUE` has the effect of *standardizing* each\n", "predictor, using (6.6), prior to generating the principal\n", "components, so that the scale on which each variable is measured will not have an effect.\n", " Setting `validation = \"CV\"` causes\n", "`pcr()` to compute the ten-fold cross-validation error for each possible\n", "value of $M$, the number of principal components used. The resulting fit can be examined using `summary()`." ] }, { "cell_type": "code", "execution_count": null, "id": "3869b6d8", "metadata": { "name": "chunk43" }, "outputs": [], "source": [ "summary(pcr.fit)" ] }, { "cell_type": "markdown", "id": "5908cc4c", "metadata": {}, "source": [ "The CV score is provided for each possible number of components, ranging\n", "from $M=0$ onwards. (We have printed the CV output only up to $M=4$.)\n", "Note that `pcr()` reports the *root mean squared error*; in order to obtain the usual MSE, we must square this quantity. For instance, a root mean squared error of $352.8$ corresponds to an MSE of\n", "$352.8^2=124{,}468$.\n", "\n", "One can also plot the cross-validation scores using the\n", "`validationplot()` function. Using `val.type = \"MSEP\"`\n", "will cause the cross-validation MSE to be plotted." ] }, { "cell_type": "code", "execution_count": null, "id": "5e8b7c9d", "metadata": { "name": "chunk44" }, "outputs": [], "source": [ "validationplot(pcr.fit, val.type = \"MSEP\")" ] }, { "cell_type": "markdown", "id": "e697af8d", "metadata": {}, "source": [ "We see that the smallest cross-validation error occurs when $M=18$ components are used. This is barely fewer than $M=19$, which amounts to simply performing least squares, because when all of the components are used in PCR no dimension reduction occurs. However, from the plot we also see that the cross-validation error is roughly the same when only one component is included in the model. This suggests that a model that uses just a small number of components might suffice.\n", "\n", " The\n", "`summary()` function also provides the *percentage of variance explained* in the predictors and in the response using different numbers of components. This concept is discussed in greater detail in Chapter 12.\n", " Briefly, we can think of this as\n", "the amount of information about the predictors or the\n", "response that is captured using $M$ principal components. For example,\n", "setting $M=1$ only captures $38.31 \\%$ of all the variance, or information,\n", "in the predictors. In contrast, using $M=5$ increases the value to $84.29 \\%$. If we\n", "were to use all $M=p=19$ components, this would increase to $100 \\%$." ] }, { "cell_type": "markdown", "id": "191ce444", "metadata": {}, "source": [ "We now\n", "perform PCR on the training data and evaluate its test set performance." ] }, { "cell_type": "code", "execution_count": null, "id": "9486c230", "metadata": { "name": "chunk45" }, "outputs": [], "source": [ "set.seed(1)\n", "pcr.fit <- pcr(Salary ~ ., data = Hitters, subset = train,\n", " scale = TRUE, validation = \"CV\")\n", "validationplot(pcr.fit, val.type = \"MSEP\")" ] }, { "cell_type": "markdown", "id": "ff53f2e0", "metadata": {}, "source": [ "Now we find that the lowest cross-validation error occurs when $M=5$ components are used.\n", "We compute the test MSE as follows." ] }, { "cell_type": "code", "execution_count": null, "id": "3fd5e968", "metadata": { "name": "chunk46" }, "outputs": [], "source": [ "pcr.pred <- predict(pcr.fit, x[test, ], ncomp = 5)\n", "mean((pcr.pred - y.test)^2)" ] }, { "cell_type": "markdown", "id": "f8825324", "metadata": {}, "source": [ "This test set MSE is competitive with the results obtained using ridge regression and the lasso. However, as a result of the way PCR is implemented, the final model is more difficult to interpret because it does not perform any kind of variable selection or even directly produce coefficient estimates.\n", "\n", "Finally, we fit PCR on the full data set, using $M=5$, the number of components identified by cross-validation." ] }, { "cell_type": "code", "execution_count": null, "id": "82eeaa23", "metadata": { "lines_to_next_cell": 0, "name": "chunk47" }, "outputs": [], "source": [ "pcr.fit <- pcr(y ~ x, scale = TRUE, ncomp = 5)\n", "summary(pcr.fit)" ] }, { "cell_type": "markdown", "id": "c67272fe", "metadata": {}, "source": [ "\n", "\n" ] }, { "cell_type": "markdown", "id": "9459018e", "metadata": {}, "source": [ "### Partial Least Squares" ] }, { "cell_type": "markdown", "id": "8c8c7e8c", "metadata": {}, "source": [ "We implement partial least squares (PLS) using the `plsr()` function, also in the `pls` library. The syntax is just like that of the `pcr()` function." ] }, { "cell_type": "code", "execution_count": null, "id": "0cd0c761", "metadata": { "name": "chunk48" }, "outputs": [], "source": [ "set.seed(1)\n", "pls.fit <- plsr(Salary ~ ., data = Hitters, subset = train, scale = TRUE, validation = \"CV\")\n", "summary(pls.fit)\n", "validationplot(pls.fit, val.type = \"MSEP\")" ] }, { "cell_type": "markdown", "id": "9b266c17", "metadata": {}, "source": [ "The lowest cross-validation error occurs when only $M=1$ partial least squares directions are used. We now evaluate the corresponding test set MSE." ] }, { "cell_type": "code", "execution_count": null, "id": "68658d73", "metadata": { "name": "chunk49" }, "outputs": [], "source": [ "pls.pred <- predict(pls.fit, x[test, ], ncomp = 1)\n", "mean((pls.pred - y.test)^2)" ] }, { "cell_type": "markdown", "id": "9ccab8d8", "metadata": {}, "source": [ "The test MSE is comparable to, but slightly higher than, the test MSE obtained using ridge regression, the lasso, and PCR.\n", "\n", "Finally, we perform PLS using the full data set, using $M=1$, the number of components identified by cross-validation." ] }, { "cell_type": "code", "execution_count": null, "id": "0c93ac86", "metadata": { "name": "chunk50" }, "outputs": [], "source": [ "pls.fit <- plsr(Salary ~ ., data = Hitters, scale = TRUE,\n", " ncomp = 1)\n", "summary(pls.fit)" ] }, { "cell_type": "markdown", "id": "8a8719fc", "metadata": {}, "source": [ "Notice that the percentage of variance in `Salary` that the one-component PLS fit explains, $43.05 \\%$, is almost as much as that explained using the final five-component model PCR fit, $44.90 \\%$. This is because PCR only attempts to maximize the amount of variance explained in the predictors, while PLS searches for directions that explain variance in both the predictors and the response.\n", "\n", "\n" ] } ], "metadata": { "jupytext": { "cell_metadata_filter": "name,tags,-all" }, "kernelspec": { "display_name": "R", "language": "R", "name": "ir" } }, "nbformat": 4, "nbformat_minor": 5 }