《深度学习精要（基于R语言）》学习笔记
1、过拟合问题概述
机器学习的一个陷阱是，越复杂的数据越有可能过拟合训练数据，因此，对相同数据训练模型的性能评价会导致有偏的、过度乐观的模型性能的估计，甚至会影响到对模型的选择。
上一篇的实例也表明：尽管一个更复杂的模型几乎总是会把训练它的数据拟合得更好，但它未必能把新数据预测得更好。
本文主要介绍为了提升泛化能力而用于防止数据过拟合的不同的方法，称为无监督数据上的正则化（regularization on unsupervised data）。更具体地说，与按照减少训练（training）误差的方式来优化参数训练模型不同，正则化关注于减少测试（testing）或验证（validation）误差，这样模型在新数据上的性能会和在训练数据上的一样好。包括以下内容：
• L1 罚函数
• L2 罚函数
• 集成方法与模型平均
2、L1罚函数
L1 罚函数，也称为最小绝对值收缩和选择算子，它的基本思想是将权重向零的方向缩减的惩罚。惩罚项使用的是权重绝对值的和，所以惩罚的程度不会更小或者更大，结果是小的权重会缩减到零，作为一种方便的效果，除了防止过拟合之外，它还可以作为一种变量选择的方法。惩罚的力度是由一个超参数λ所控制的，它乘以权重绝对值的和，可以被预先设定，或者就像其他超参数那样，使用交叉验证或者一些类似的方法来优化。
把 L1 罚函数作为约束优化时，我们更容易看出它如何有效地限制了模型的复杂性。即使包括了许多预测变量，权重绝对值的和也不能超过定义的阈值。这样做的一个结果是，使用 L1 罚函数，只要有足够强的惩罚项，真的有可能包括比样例或观测还要多的预测变量。
下面通过一个模拟广义线性回归问题来看 L1 罚函数是如何工作的：
> library(pacman)
> p_load(magrittr, glmnet)
>
> set.seed(123)
> # 模拟一组多元正态分布数据
> x <- MASS::mvrnorm(n = 200, mu = c(0, 0, 0, 0, 0),
Sigma = matrix(c(1, 0.9999, 0.99, 0.99, 0.1,
+ 0.9999, 1, 0.99, 0.99, 0.1,
+ 0.99, 0.99, 1, 0.99, 0.1,
+ 0.99, 0.99, 0.99, 1, 0.1,
+ 0.1, 0.1, 0.1, 0.1, 1), ncol = 5))
>
> # 模拟一组正态分布数据
> y <- rnorm(200, 3 + x %*% matrix(c(1, 1, 1, 1, 0)), 0.5)
> head(x)
## [,1] [,2] [,3] [,4] [,5]
## [1,] 0.63043 0.62539 0.55882 0.7107 -2.10443
## [2,] 0.19737 0.20667 0.34580 0.3419 -1.27003
## [3,] -1.59643 -1.60853 -1.51857 -1.5233 0.05489
## [4,] -0.04584 -0.06214 0.05673 -0.1577 -0.54775
## [5,] -0.09989 -0.10379 -0.23926 -0.1275 0.39342
## [6,] -1.82648 -1.82852 -1.60641 -1.6362 0.24322
> head(y)
## [1] 5.027 3.572 -3.256 2.725 1.155 -3.377
glmnet包的glmnet()函数能拟合L1罚函数或L2罚函数，取哪一个函数是由参数alpha来决定的。当alpha=1时，它是L1罚函数（也就是lasso）；当alpha=2时，它是L2罚函数（也就是岭回归）。
使用前100行数据作为训练集，交叉验证自动调优超参数lambda：
> x.train <- x[1:100, ]
> y.train <- y[1:100]
>
> lasso.cv <- cv.glmnet(x.train, y.train, alpha = 1)
>
> # 画图查看lasso回归对象各个lambda值的均方误差
> plot(lasso.cv)
从图中可以看出，当惩罚变得太大（lambda增大）时，交叉验证模型的误差增加。
最后，使用线性回归OLS的系数来和lasso的系数对比：
> ols <- lm(y.train ~ x.train)
>
> cbind(OLS = coef(ols), Lasso = coef(lasso.cv)[, 1]) %>% print
## OLS Lasso
## (Intercept) 3.07450 3.0389
## x.train1 -1.79670 1.1957
## x.train2 3.94472 0.9800
## x.train3 0.62136 0.4413
## x.train4 1.18204 1.1050
## x.train5 0.08503 0.0000
OLS估计对于第一个预测变量的值是太低了，对于第二个预测变量的值又太高了。反之lasso中变量5的系数直接被惩罚为0，跟真实系数3、1、1、1、1、0对比，Lasso更准确。
3、L2罚函数
L2罚函数，也叫作岭回归（ridge regression），除了惩罚是基于权重平方而不是基于权重绝对值的和之外，在许多方面和L1罚函数很相似。
同样，我们还是使用上面的方式看看L2罚函数是如何工作的：
> ridge.cv <- cv.glmnet(x.train, y.train, alpha = 0)
> par(mfrow = c(1, 2))
> plot(lasso.cv)
> plot(ridge.cv)
曲线跟之前的略有不同，ridge回归中误差对lambda值的增加是渐进的。但是，总体上和lasso一样，岭回归往往在非常小的lambda值上表现很好，这可能表明lasso对于提高样本外性能/泛化能力并不是很有帮助。
还是使用线性回归系数进行对比：
> cbind(OLS = coef(ols), Lasso = coef(lasso.cv)[, 1], Ridge = coef(ridge.cv)[, 1]) %>%
+ print
## OLS Lasso Ridge
## (Intercept) 3.07450 3.0389 3.04427
## x.train1 -1.79670 1.1957 0.92560
## x.train2 3.94472 0.9800 0.93024
## x.train3 0.62136 0.4413 0.92107
## x.train4 1.18204 1.1050 0.94465
## x.train5 0.08503 0.0000 0.06053
尽管岭回归没有把第五个预测因子的系数缩减到零，但还是要比OLS的系数小，而且其余的参数都有轻微缩减，和真实值3、1、1、1、1、0非常接近。
接下来我们看看权重衰减（L2罚函数）在神经网络模型中的应用，前面我们使用caret包和nnet包训练的神经网络使用了0.01的权重衰减，为了探索权重衰减的使用，我们可以使用交叉验证来调整它的取值。
> # 还是使用手写数字识别数据集
> digits.train <- read.csv("./data_set/digit-recognizer/train.csv")
> digits.train$label <- factor(digits.train$label, levels = 0:9)
> ind <- 1:5000
> digits.x <- digits.train[ind, -1]
> digits.y <- digits.train[ind, 1]
创建并使用多线程：
> p_load(parallel, foreach, doSNOW)
> cl <- makeCluster(4)
>
> # 加载R包
> clusterEvalQ(cl, {
+ library(RSNNS)
+ })
>
> # 注册集群
> registerDoSNOW(cl)
在数字分类问题上建立一个神经网络，权重衰减在0（没有惩罚）和0.10之间变化。循环迭代次数为100和150:
> p_load(caret)
> set.seed(123)
> decay.ml1 <- lapply(c(100, 150), function(its) {
+ train(digits.x, digits.y, method = "nnet",
+ tuneGrid = expand.grid(.size = 10, .decay = c(0, 0.1)),
+ trControl = trainControl(method = "cv", number = 5, repeats = 1),
+ MaxNWts = 10000, maxit = its)
+ })
查看迭代次数限制在100次时的结果：
> decay.ml1[[1]]
## Neural Network
##
## 5000 samples
## 784 predictor
## 10 classes: '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 3999, 4001, 3999, 4000, 4001
## Resampling results across tuning parameters:
##
## decay Accuracy Kappa
## 0.0 0.6030 0.5585
## 0.1 0.5808 0.5340
##
## Tuning parameter 'size' was held constant at a value of 10
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 10 and decay = 0.
选择的参数为size = 10 and decay = 0，此时Accuracy=0.603，即非正则化模型（准确度=0.603）比正则化模型（准确度=0.5808）表现要好，尽管两个模型的表现都不怎么好。
查看迭代次数限制在150次时的结果：
> decay.ml1[[2]]
## Neural Network
##
## 5000 samples
## 784 predictor
## 10 classes: '0', '1', '2', '3', '4', '5', '6', '7', '8', '9'
##
## No pre-processing
## Resampling: Cross-Validated (5 fold)
## Summary of sample sizes: 3998, 4000, 4001, 4001, 4000
## Resampling results across tuning parameters:
##
## decay Accuracy Kappa
## 0.0 0.5765 0.5291
## 0.1 0.6084 0.5648
##
## Tuning parameter 'size' was held constant at a value of 10
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were size = 10 and decay = 0.1.
150次时选择的参数为size = 10 and decay = 0.1，此时Accuracy=0.6084，即非正则化模型（准确度=0.5765）比正则化模型（准确度=0.6084）表现要差。
这些结果强调的重点是，正则化通常对更复杂的、有更大的灵活性拟合（以及过拟合）数据的模型最有用，同时（在那些对于数据合适的或者过于简单的模型）正则化实际上可能降低了性能。
4、集成和模型平均
另一种正则化的方法是创建模型的集成并且把它们组合起来，如果我们有不同的模型，每一个生成一组预测，每个模型也许会在预测中造成误差。一个模型可能把某个值预测得太高，另一个可能会把它预测得太低，这样平均起来，一些误差相互抵消，产生比通过其他方法更为准确的预测。
> # 创建模拟数据集
> set.seed(123)
> df <- data.frame(x = rnorm(400))
>
> df$y = with(df, rnorm(400, 2 + ifelse(x < 0, x + x^2, x + x^2.5), 1))
>
> # 拆分训练集和测试集
> train.df <- df[1:200, ]
> test.df <- df[200:400, ]
>
> # 创建三个模型
> model1 <- lm(y ~ x, data = train.df)
> model2 <- lm(y ~ I(x^2), data = train.df)
> # pmax()和pmin()将一个或多个向量作为参数，将它们循环到公共长度，
> # 并返回一个向量，作为parallel函数最大值（或最小值）的参数向量
> model3 <- lm(y ~ pmax(x, 0) + pmin(x, 0), data = train.df)
>
> # 合并输出模型的均方误差
> cbind(M1 = summary(model1)$r.squared,
+ M2 = summary(model2)$r.squared,
+ M3 = summary(model3)$r.squared)
## M1 M2 M3
## [1,] 0.3549 0.6496 0.7024
可以看到，三个模型在训练集上的均方误差差别还是很大的。
查看三个模型拟合值之间的相关性：
> cbind(M1 = fitted(model1),
+ M2 = fitted(model2),
+ M3 = fitted(model3)) %>% cor %>%
+ corrplot::corrplot.mixed()
M3的拟合值与M1、M2的拟合值有较强的相关性。
接下来看看模型在测试集上的表现：
> pred <- data.frame(M1.pred = predict(model1, newdata = test.df), M2.pred = predict(model2,
+ newdata = test.df), M3.pred = predict(model3, newdata = test.df))
> pred$Mean <- rowMeans(pred)
>
> # 查看相关性
> cbind(test.df, pred) %>% cor %>% corrplot::corrplot.mixed()
Mean与y的相关性高于其他任何一个模型，说明三个模型预测的平均确实比任何一个模型的个别表现都要好。当然，这只是在每个模型的表现差不多好的时候，才可以保证是真的，所以理想的情况是在模型的预测值之间有较低的相关性，因为这会产生最佳的平均性能。
随机森林模型使用自助聚集（bootstrap aggregating）的决策树，其中数据采用替换抽样来形成相等规模的数据集，模型在每一个数据上训练，然后将这些结果平均。因为模型是在每个数据集上训练的，如果某个特殊的变化对少数样例或数据的一个罕见巧合是独特的，它可能只在一个模型中出现。当预测在由每个重抽样的数据集所训练的许多模型上平均时，这种过拟合往往会减少。另外，随机森林在每个分划的节点上随机地选择了一个特征子集，目的是减少模型与模型的相关性并由此提高整体的平均性能。
5、实例：使用丢弃提升样本外模型性能
自助聚集和模型平均在深度神经网络中并不常用，因为训练每个模型的成本会相当高，所以就时间和计算资源来说，多次重复这个过程会变得相当昂贵。
丢弃是一种相对较新的正则化方法，对于大型和复杂的深度神经网络特别有价值。在模型训练的过程中，单元（例如输入、隐藏神经元等）连同所有从它们出发的和到达它们的联系一起按照概率在某一步骤/更新中被丢弃。考虑丢弃会迫使模型对于扰动更加稳健。
> # 还是使用手写数字识别数据集
> # 使用deepnet包的nn.train()函数
> clusterEvalQ(cl,{
+ library(deepnet)
+ })
## [[1]]
## [1] "deepnet" "RSNNS" "Rcpp" "snow" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[2]]
## [1] "deepnet" "RSNNS" "Rcpp" "snow" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[3]]
## [1] "deepnet" "RSNNS" "Rcpp" "snow" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
##
## [[4]]
## [1] "deepnet" "RSNNS" "Rcpp" "snow" "stats" "graphics"
## [7] "grDevices" "utils" "datasets" "methods" "base"
> # 并行计算4个模型
> nn.models <- foreach(i=1:4,.combine = "c") %dopar% {
+ set.seed(123)
+ list(nn.train(
+ x = as.matrix(digits.x),
+ y = model.matrix( ~ 0 + digits.y),
+ # 40个或者80个神经元
+ hidden = c(40,80,40,80)[i],
+ # 激活函数tanh
+ activationfun = "tanh",
+ # 学习率0.8
+ learningrate = 0.8,
+ momentum = 0.5,
+ numepochs = 150,
+ output = "softmax",
+ # 隐藏单位两个丢弃，丢弃比例为0.5
+ hidden_dropout = c(0,0,0.5,0.5)[i],
+ # 可见单位两个丢弃，丢弃比例为0.2
+ visible_dropout = c(0,0,0.2,0.2)[i]
+ ))
+ }
循环模型，获得预测值并得到模型的整体性能：
> p_load(deepnet)
> nn.pred <- lapply(nn.models, function(obj) {
+ encodeClassLabels(nn.predict(obj, as.matrix(digits.x)))
+ })
>
> perf.train <- do.call(cbind, lapply(nn.pred, function(yhat) {
+ caret::confusionMatrix(xtabs(~I(yhat - 1) + digits.y))$overall
+ }))
>
> colnames(perf.train) <- c("N40", "N80", "N40_REG", "N80_REG")
>
> options(digits = 4)
> perf.train
## N40 N80 N40_REG N80_REG
## Accuracy 0.9060 0.9662 0.9234 0.9396
## Kappa 0.8955 0.9624 0.9149 0.9329
## AccuracyLower 0.8976 0.9608 0.9157 0.9326
## AccuracyUpper 0.9140 0.9710 0.9306 0.9460
## AccuracyNull 0.1116 0.1116 0.1116 0.1116
## AccuracyPValue 0.0000 0.0000 0.0000 0.0000
## McnemarPValue NaN NaN NaN NaN
40个神经元的有正则化的模型比没有正则化的模型表现要好，但是80个神经元没有正则化的模型比有正则化的模型表现得要好。
看看在测试集上的表现：
> ind2 <- 5001:10000
> test.x <- digits.train[ind2, -1]
> test.y <- digits.train[ind2, 1]
>
> nn.pred.test <- lapply(nn.models, function(obj) {
+ encodeClassLabels(nn.predict(obj, as.matrix(test.x)))
+ })
>
> perf.test <- do.call(cbind, lapply(nn.pred.test, function(yhat) {
+ caret::confusionMatrix(xtabs(~I(yhat - 1) + test.y))$overall
+ }))
>
> colnames(perf.test) <- c("N40", "N80", "N40_REG", "N80_REG")
>
> # 对比模型在训练集和测试集上的准确度
> p_load(dplyr)
> perf.train %>% as.data.frame() %>%
+ bind_rows(as.data.frame(perf.test)) %>%
+ filter(rownames(.) == 1 | rownames(.) == 8) %>%
+ mutate(Dateset = c("train", "test")) %>%
+ as.data.frame() %>% print()
## N40 N80 N40_REG N80_REG Dateset
## 1 0.9060 0.9662 0.9234 0.9396 train
## 2 0.8656 0.8768 0.8896 0.9014 test
通过测试集的性能可知，正则化的模型比对应的非正则化的模型性能要好，尽管它们在测试数据中都比在训练数据中的性能要差，但正则化后的性能下降得更少。这也提现了正则化的价值。