We split our dataset into k groups. We train our model on k-1 folds and then test on the last fold. We repeat this until every k has been tested once.
i. The validation set approach can lead to overestimates of the test error rate, while the k-fold CV can introduce “intermediate bias”. However, k-fold CV has a lower variance. ii. K-fold CV has a computational advantage but also provides more accurate estimates of the test error rate. But again k-fold CV can introduce more bias than LOOCV which is relatively unbiased estimates of the test error rate.
In Chapter 4, we used logistic regression to predict the probability of default using income and balance on the Default data set. We will now estimate the test error of this logistic regression model using the validation set approach. Do not forget to set a random seed before beginning your analysis.
log.default <- glm(default~income+balance, data=Default, family = 'binomial')
summary(log.default)
##
## Call:
## glm(formula = default ~ income + balance, family = "binomial",
## data = Default)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4725 -0.1444 -0.0574 -0.0211 3.7245
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.154e+01 4.348e-01 -26.545 < 2e-16 ***
## income 2.081e-05 4.985e-06 4.174 2.99e-05 ***
## balance 5.647e-03 2.274e-04 24.836 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2920.6 on 9999 degrees of freedom
## Residual deviance: 1579.0 on 9997 degrees of freedom
## AIC: 1585
##
## Number of Fisher Scoring iterations: 8
Using the validation set approach, estimate the test error of this model. In order to do this, you must perform the following steps:
Split the sample set into a training set and a validation set.
#make this example reproducible
set.seed(1)
#create ID column
Default = as.data.frame(Default)
Default$id <- 1:nrow(Default)
#use 70% of dataset as training set and 30% as test set
train <- Default %>% dplyr::sample_frac(0.70)
test <- dplyr::anti_join(Default, train, by = 'id')
fit.glm = glm(default ~ income + balance, data = train, family ="binomial")
# NOTE: I will not subset, as I am using my train data that is newly created
# Do not take points off for this
summary(fit.glm)
##
## Call:
## glm(formula = default ~ income + balance, family = "binomial",
## data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4481 -0.1402 -0.0561 -0.0211 3.3484
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.167e+01 5.214e-01 -22.379 < 2e-16 ***
## income 2.560e-05 6.012e-06 4.258 2.06e-05 ***
## balance 5.574e-03 2.678e-04 20.816 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2030.3 on 6999 degrees of freedom
## Residual deviance: 1079.6 on 6997 degrees of freedom
## AIC: 1085.6
##
## Number of Fisher Scoring iterations: 8
probability = predict(fit.glm, newdata = test, type = "response")
predicted = ifelse(probability > 0.5, "Yes", "No")
misclassified = sum(predicted != test$default)
error = misclassified / nrow(test)
cat("Validation set error: ", error, "\n")
## Validation set error: 0.02666667
# round 1
#make this example reproducible
set.seed(1)
#create ID column
Default = as.data.frame(Default)
Default$id <- 1:nrow(Default)
#use 50% of dataset as training set and 50% as test set
train <- Default %>% dplyr::sample_frac(0.5)
test <- dplyr::anti_join(Default, train, by = 'id')
#Fit the reg model
fit.glm = glm(default ~ income + balance, data = train, family ="binomial")
# NOTE: I will not subset, as I am using my train data that is newly created
# Do not take points off for this
#summary(fit.glm)
# use train data to predict
probability = predict(fit.glm, newdata = test, type = "response")
predicted = ifelse(probability > 0.5, "Yes", "No")
error1 = misclassified / nrow(test)
cat("Validation set error for 50% training and testing is: ", error1, "\n")
## Validation set error for 50% training and testing is: 0.016
# round 2
set.seed(1)
Default = as.data.frame(Default)
Default$id <- 1:nrow(Default)
train <- Default %>% dplyr::sample_frac(0.75)
test <- dplyr::anti_join(Default, train, by = 'id')
fit.glm = glm(default ~ income + balance, data = train, family ="binomial")
probability = predict(fit.glm, newdata = test, type = "response")
predicted = ifelse(probability > 0.5, "Yes", "No")
error2 = misclassified / nrow(test)
cat("Validation set error for 75% train, 25% test is: ", error2, "\n")
## Validation set error for 75% train, 25% test is: 0.032
# round 3
set.seed(1)
#create ID column
Default = as.data.frame(Default)
Default$id <- 1:nrow(Default)
train <- Default %>% dplyr::sample_frac(0.90)
test <- dplyr::anti_join(Default, train, by = 'id')
fit.glm = glm(default ~ income + balance, data = train, family ="binomial")
probability = predict(fit.glm, newdata = test, type = "response")
predicted = ifelse(probability > 0.5, "Yes", "No")
error3 = misclassified / nrow(test)
cat("Validation set error for 90% train, 10% testing is: ", error3, "\n")
## Validation set error for 90% train, 10% testing is: 0.08
#make this example reproducible
set.seed(1)
#create ID column
Default = as.data.frame(Default)
Default$id <- 1:nrow(Default)
#use 70% of dataset as training set and 30% as test set
train <- Default %>% dplyr::sample_frac(0.70)
test <- dplyr::anti_join(Default, train, by = 'id')
fit.glm = glm(default ~ income + balance + student, data = train, family ="binomial")
summary(fit.glm)
##
## Call:
## glm(formula = default ~ income + balance + student, family = "binomial",
## data = train)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -2.4482 -0.1374 -0.0540 -0.0202 3.4027
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.095e+01 5.880e-01 -18.616 <2e-16 ***
## income 6.273e-06 9.845e-06 0.637 0.524
## balance 5.678e-03 2.741e-04 20.715 <2e-16 ***
## studentYes -7.167e-01 2.886e-01 -2.483 0.013 *
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2030.3 on 6999 degrees of freedom
## Residual deviance: 1073.5 on 6996 degrees of freedom
## AIC: 1081.5
##
## Number of Fisher Scoring iterations: 8
probability = predict(fit.glm, newdata = test, type = "response")
predicted = ifelse(probability > 0.5, "Yes", "No")
error = misclassified / nrow(test)
cat("Validation set error is: ", error, "\n")
## Validation set error is: 0.02666667
We continue to consider the use of a logistic regression model to predict the probability of default using income and balance on the Default data set. In particular, we will now compute estimates for the standard errors of the income and balance logistic regression coefficients in two different ways: (1) using the bootstrap, and (2) using the standard formula for computing the standard errors in the glm() function. Do not forget to set a random seed before beginning your analysis.
(a)Using the summary() and glm() functions, determine the estimated standard errors for the coefficients associated with income and balance in a multiple logistic regression model that uses both predictors.
set.seed(1)
fit6 <- glm(default~income+balance, data=Default, family = 'binomial')
summary(fit6)$coef
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.154047e+01 4.347564e-01 -26.544680 2.958355e-155
## income 2.080898e-05 4.985167e-06 4.174178 2.990638e-05
## balance 5.647103e-03 2.273731e-04 24.836280 3.638120e-136
boot.fn <- function(data, index) {
fit1 <- glm(default~income+balance, data=data, family = 'binomial', subset = index)
return(coef(fit1))
}
(c)Use the boot() function together with your boot.fn() function to estimate the standard errors of the logistic regression coefficients for income and balance.
boot(Default, boot.fn, 500)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Default, statistic = boot.fn, R = 500)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* -1.154047e+01 -2.298134e-02 4.212334e-01
## t2* 2.080898e-05 -2.053140e-07 5.184890e-06
## t3* 5.647103e-03 1.678038e-05 2.178846e-04
The bootstrap function with using the glm function return values for std. error of t1=4.212, t2=5.184, and t3=2.179.
We will now consider the Boston housing data set, from the ISLR2 library.
(a)Based on this data set, provide an estimate for the population mean of medv. Call this estimate ˆµ.
muhat <- mean(Boston$medv)
muhat
## [1] 22.53281
(b)Provide an estimate of the standard error of ˆµ. Interpret this result. Hint: We can compute the standard error of the sample mean by dividing the sample standard deviation by the square root of the number of observations.
stderrhat <- sd(Boston$medv) / sqrt(dim(Boston)[1])
stderrhat
## [1] 0.4088611
We compute that our sample will be .409 deviations from the population mean.
bootfn <- function(data, index)
{
muhat <- mean(data[index])
return (muhat)
}
bootst <- boot(Boston$medv, bootfn, 500)
bootst
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Boston$medv, statistic = bootfn, R = 500)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 22.53281 -0.008388933 0.4106569
t.test(Boston$medv)
##
## One Sample t-test
##
## data: Boston$medv
## t = 55.111, df = 505, p-value < 2.2e-16
## alternative hypothesis: true mean is not equal to 0
## 95 percent confidence interval:
## 21.72953 23.33608
## sample estimates:
## mean of x
## 22.53281
confintr <- c(bootst$t0 - 2 * .408, bootst$t0 + 2 * .408)
confintr
## [1] 21.71681 23.34881
medianhat <- median(Boston$medv)
medianhat
## [1] 21.2
bootfn <- function(data, index)
{
medianhat <- median(data[index])
return (medianhat)
}
boot(Boston$medv, bootfn, 500)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Boston$medv, statistic = bootfn, R = 500)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 21.2 -0.0403 0.393396
tenperc <- quantile(Boston$medv, c(.1))
tenperc
## 10%
## 12.75
bootfn <- function(data, index)
{
tenperc <- quantile(data[index], c(0.1))
return (tenperc)
}
boot(Boston$medv, bootfn, 1000)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Boston$medv, statistic = bootfn, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 12.75 0.0144 0.5069168