K-fold cross-validation is implemented by randomly divide the observations, n, into numbers of k folds of equal size. Each fold is treated as a validation set once only and the remainding folds are fitted for training at every k times. Then the test estimate is calulated from the average of MSE (mean squared error).
In the k-fold cross-validation process, the entire datatset is used for training and validation while the validation set only uses a single train-test slipt. Therefore, the k-fold cross-validation provides more reliable estimate and reduce bias compared to the validation set approach. However, since k-fold cross-validation requires training and testing the dataset multiple times, it can pose problems such as higher cost and overfitting.
In LOOCV, k=n, meaning n can be really large. So in such case, k-fold cross-validation approach would be less expensive, more efficient, less sensitive to outliers, and more stable performance. However, LOOCV provides more unbias estimate due to its larger run times.
d0 <- glm(default ~ income + balance, family = "binomial", data = Default)
summary(d0)
##
## Call:
## glm(formula = default ~ income + balance, family = "binomial",
## data = Default)
##
## 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
set.seed(123)
d0_split <- sample(nrow(Default), 0.8 * nrow(Default), replace = F) # 80/20 split
d0_train <- Default[d0_split, ]
d0_test <- Default[-d0_split, ]
d1 <- glm(default ~ income + balance, family = "binomial", data = d0_train)
summary(d1)
##
## Call:
## glm(formula = default ~ income + balance, family = "binomial",
## data = d0_train)
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) -1.161e+01 4.884e-01 -23.78 < 2e-16 ***
## income 2.174e-05 5.602e-06 3.88 0.000104 ***
## balance 5.677e-03 2.548e-04 22.28 < 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: 2340.6 on 7999 degrees of freedom
## Residual deviance: 1258.1 on 7997 degrees of freedom
## AIC: 1264.1
##
## Number of Fisher Scoring iterations: 8
predprob <- predict(d1, newdata = d0_test, type = "response")
predclass <- ifelse(predprob > 0.5, "Yes", "No")
mean(predclass != d0_test$default)
## [1] 0.026
set.seed(123)
c_split1 <- sample(nrow(Default), 0.7 * nrow(Default), replace = F) # 70/30 split
c_train1 <- Default[c_split1, ]
c_test1 <- Default[c_split1, ]
c1 <- glm(default ~ income + balance, family = "binomial", data = c_train1)
c_predprob1 <- predict(c1, newdata = c_test1, type = "response")
c_predclass1 <- ifelse(c_predprob1 > 0.5, "Yes", "No")
mean(c_predclass1 != c_test1$default)
## [1] 0.02628571
set.seed(123)
c_split2 <- sample(nrow(Default), 0.6* nrow(Default), replace = F) # 60/40 split
c_train2 <- Default[c_split2, ]
c_test2 <- Default[c_split2, ]
c2 <- glm(default ~ income + balance, family = "binomial", data = c_train2)
c_predprob2 <- predict(c2, newdata = c_test2, type = "response")
c_predclass2 <- ifelse(c_predprob2 > 0.5, "Yes", "No")
mean(c_predclass2 != c_test2$default)
## [1] 0.02633333
set.seed(123)
c_split3 <- sample(nrow(Default), 0.5* nrow(Default), replace = F) # 50/50 split
c_train3 <- Default[c_split3, ]
c_test3 <- Default[c_split3, ]
c3 <- glm(default ~ income + balance, family = "binomial", data = c_train3)
c_predprob3 <- predict(c3, newdata = c_test3, type = "response")
c_predclass3 <- ifelse(c_predprob3 > 0.5, "Yes", "No")
mean(c_predclass3 != c_test3$default)
## [1] 0.0258
For the 80/20 split - Validation set error: 0.026 For the 70/30 split - Validation set error: 0.02628571 For the 60/40 split - Validation set error: 0.02633333 For the 50/50 split - Validation set error: 0.0258 Comparing differenlt splits, the validation errors has slight variations depending on the dataset split.
Default$student_dummy <- ifelse(Default$student == "Yes", 1, 0)
set.seed(123)
d2_split <- sample(1:nrow(Default), 0.7 * nrow(Default))
d2_train <- Default[d2_split, ]
d2_test <- Default[-d2_split, ]
d2 <- glm(default ~ income + balance + student_dummy, family = "binomial", data = d2_train)
d2_pred <- predict(d2, newdata = d2_test, type = "response")
d2_predclass <- ifelse(d2_pred > 0.5, "Yes", "No")
mean(d2_predclass != d2_test$default)
## [1] 0.027
A student dummy variable was created where yes = 1, and no=0. I wanted to use the 70/30 split for this question and the testing error increased from 0.026 to 0.027 after including the student dummy variable. Therefore, it is suggested that including a dummy variable for student leads to a reduction in the test error rate.
d0 <- glm(default ~ income + balance, family = "binomial", data = Default)
summary(d0)
##
## Call:
## glm(formula = default ~ income + balance, family = "binomial",
## data = Default)
##
## 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
Standard error for the coefficient: Intercept: 4.348e-01 Income: 4.985e-06 Balance: 2.274e-04
boot.fn <- function(data, index) {
model <- glm(default ~ income + balance, family = "binomial", data = data, subset= index)
return(coef(model))}
library(boot)
boot(data = Default, statistic = boot.fn, R = 1000)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Default, statistic = boot.fn, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* -1.154047e+01 -2.781464e-02 4.199862e-01
## t2* 2.080898e-05 1.610485e-07 4.733164e-06
## t3* 5.647103e-03 1.305788e-05 2.215018e-04
Bootstrap result: Intercept: 4.335388e-01 Income: 4.885399e-06 Balance: 2.268373e-04 Comparing both methods, it is clear that the estimated standard errors are relatively close with small variation.
mean(Boston$medv)
## [1] 22.53281
sd(Boston$medv) / sqrt(length(Boston$medv))
## [1] 0.4088611
boot_fn1 <- function(data, index) {
data_subset <- data[index, ]
return(mean(data_subset$medv))
}
library(boot)
set.seed(123)
boot(data = Boston, statistic = boot_fn1, R = 1000)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Boston, statistic = boot_fn1, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 22.53281 -0.01607372 0.4045557
Standard error from (b):0.4088611 compare to 0.4045557 from using the bootstrap, they have similar estimate of standard error and the difference is very small (0.004).
c(mean(Boston$medv)-2*0.4045557, mean(Boston$medv)+2*0.4045557)
## [1] 21.72369 23.34192
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
95 percent confidence intervalfrom t test: [21.72953, 23.33608] 95 percent confidence intervalfrom bootstrap: [21.72369, 23.34192] Both results are very close with little variation.
median(Boston$medv)
## [1] 21.2
boot.fn2 <- function(data, index)
{ return (median(data[index]))}
boot(Boston$medv, boot.fn2, 1000)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Boston$medv, statistic = boot.fn2, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 21.2 -0.0264 0.3783996
The mdian std. error is 0.3783996, which is close to the mean std. error of 0.4045557 but still relatively small.
quantile(Boston$medv, c(0.1))
## 10%
## 12.75
boot.fn3 <- function(data, index)
{return (quantile(data[index], c(0.1)))}
boot(Boston$medv, boot.fn3, 1000)
##
## ORDINARY NONPARAMETRIC BOOTSTRAP
##
##
## Call:
## boot(data = Boston$medv, statistic = boot.fn3, R = 1000)
##
##
## Bootstrap Statistics :
## original bias std. error
## t1* 12.75 0.02485 0.5082798
The std error for tenth percentile of medv is 0.5082798, which is very high compare to both mean and median std error.