> library(pacman)
> p_load(dplyr, caret)
集成模型方法：
1、装袋-使用同一个数据集的不同样本（可通过有放回的抽样创建）来训练同一个模型的多个版本，然后这些模型会对新的观测数据进行投票，并根据问题的类型作出平均或多数的决策。
对非线性模型装袋才有意义，因为装袋过程就是对产生的模型进行一次取平均值（线性运算）的处理，从而在线性回归里就不会看到任何改善，因为没有增加模型的表达力。
ipred包包含了为通过rpart()构建的树构建一个装袋预测器的工具，可以通过bagging()函数实现。
2、增强-训练一序列模型，并给没有正确分类或远离其预测值的观测数据分配权重，以便增强后续训练的模型把它们放在优先地位。
增强在默认情况下会用到所有的训练数据，并在没有任何惩罚或收缩准则的情况下逐步尝试纠正它犯的错误（虽然要训练的单个模型本身可以是正则化的），因此，增强有时候也会过拟合。另外，很多增强算法在分类过程中对产生的假阳性分类误差和假阴性分类误差是没有差别的处理其权值，即具有一个对称的损失函数，也是其局限性。
fastAdaboost包和gbm包可以实现集成模型中的增强算法。
任务：分析望远镜照相机拍下的辐射中出现的模式，预测某个模式是来源于泄露到大气中的伽马射线还是常规的背景辐射。
1、数据准备
> magic <- readr::read_csv("data_set/magic04.data", col_names = F)
> names(magic) <- c("flength", "fwidth", "fsize", "fconc", "fconc1", "fasym",
+ "fm3long", "fm3trans", "falpha", "fdisk", "class")
>
> str(magic)
## tibble [19,020 × 11] (S3: spec_tbl_df/tbl_df/tbl/data.frame)
## $ flength : num [1:19020] 28.8 31.6 162.1 23.8 75.1 ...
## $ fwidth : num [1:19020] 16 11.72 136.03 9.57 30.92 ...
## $ fsize : num [1:19020] 2.64 2.52 4.06 2.34 3.16 ...
## $ fconc : num [1:19020] 0.3918 0.5303 0.0374 0.6147 0.3168 ...
## $ fconc1 : num [1:19020] 0.1982 0.3773 0.0187 0.3922 0.1832 ...
## $ fasym : num [1:19020] 27.7 26.27 116.74 27.21 -5.53 ...
## $ fm3long : num [1:19020] 22.01 23.82 -64.86 -6.46 28.55 ...
## $ fm3trans: num [1:19020] -8.2 -9.96 -45.22 -7.15 21.84 ...
## $ falpha : num [1:19020] 40.09 6.36 76.96 10.45 4.65 ...
## $ fdisk : num [1:19020] 81.9 205.3 256.8 116.7 356.5 ...
## $ class : chr [1:19020] "g" "g" "g" "g" ...
## - attr(*, "spec")=
## .. cols(
## .. X1 = col_double(),
## .. X2 = col_double(),
## .. X3 = col_double(),
## .. X4 = col_double(),
## .. X5 = col_double(),
## .. X6 = col_double(),
## .. X7 = col_double(),
## .. X8 = col_double(),
## .. X9 = col_double(),
## .. X10 = col_double(),
## .. X11 = col_character()
## .. )
> DataExplorer::profile_missing(magic)
## # A tibble: 11 x 3
## feature num_missing pct_missing
##
## 1 flength 0 0
## 2 fwidth 0 0
## 3 fsize 0 0
## 4 fconc 0 0
## 5 fconc1 0 0
## 6 fasym 0 0
## 7 fm3long 0 0
## 8 fm3trans 0 0
## 9 falpha 0 0
## 10 fdisk 0 0
## 11 class 0 0
不存在缺失值。
> table(magic$class)
##
## g h
## 12332 6688
g表示伽马射线，h表示背景辐射，重新编码为1和-1。
> magic$class <- as.factor(ifelse(magic$class == "g", 1, -1))
2、标准化和中心化
> pre <- preProcess(magic[, -11], method = c("center", "scale"))
> magic.new <- predict(pre, magic[, -11]) %>%
+ bind_cols(class = magic$class)
> str(magic.new)
## tibble [19,020 × 11] (S3: tbl_df/tbl/data.frame)
## $ flength : num [1:19020] -0.577 -0.511 2.568 -0.695 0.517 ...
## $ fwidth : num [1:19020] -0.337 -0.57 6.206 -0.687 0.476 ...
## $ fsize : num [1:19020] -0.381 -0.649 2.616 -1.029 0.711 ...
## $ fconc : num [1:19020] 0.0628 0.8204 -1.8758 1.282 -0.3475 ...
## $ fconc1 : num [1:19020] -0.149 1.472 -1.773 1.607 -0.285 ...
## $ fasym : num [1:19020] 0.541 0.5169 2.0449 0.5328 -0.0202 ...
## $ fm3long : num [1:19020] 0.225 0.26 -1.478 -0.334 0.353 ...
## $ fm3trans: num [1:19020] -0.406 -0.49 -2.183 -0.355 1.037 ...
## $ falpha : num [1:19020] 0.477 -0.815 1.889 -0.659 -0.881 ...
## $ fdisk : num [1:19020] -1.498 0.153 0.843 -1.031 2.176 ...
## $ class : Factor w/ 2 levels "-1","1": 2 2 2 2 2 2 2 2 2 2 ...
3、拆分训练集和测试集
> ind <- createDataPartition(magic.new$class, p = 0.8, list = F)
> dtrain <- magic.new[ind, ]
> dtest <- magic.new[-ind, ]
4、逻辑回归
使用基本的逻辑回归模型，其结果作为基准对比。
> fit.glm <- glm(class ~ ., data = dtrain, family = binomial(link = "logit"))
> hat.train <- ifelse(fit.glm$fitted.values >= 0.5, 1, -1) %>%
+ as.factor()
> hat.test <- predict(fit.glm, newdata = dtest, type = "response")
> hat.test <- ifelse(hat.test >= 0.5, 1, -1) %>%
+ as.factor()
> res <- tibble(model = "glm",
+ train_acc = mean(hat.train == dtrain$class),
+ test_acc = mean(hat.test == dtest$class))
> res
## # A tibble: 1 x 3
## model train_acc test_acc
##
## 1 glm 0.789 0.796
5、装袋算法
> ctrl <- trainControl(method = "cv", number = 3L)
>
> set.seed(123)
> fit.bag <- train(class ~ ., method = "treebag", data = dtrain, trControl = ctrl)
> fit.bag$finalModel
##
## Bagging classification trees with 25 bootstrap replications
> train_acc <- mean(predict(fit.bag, newdata = dtrain, type = "raw") == dtrain$class)
> test_acc <- mean(predict(fit.bag, newdata = dtest, type = "raw") == dtest$class)
> res <- res %>%
+ bind_rows(tibble(model = "bag",
+ train_acc = train_acc,
+ test_acc = test_acc))
> res
## # A tibble: 2 x 3
## model train_acc test_acc
##
## 1 glm 0.789 0.796
## 2 bag 0.997 0.879
6、增强 - AdaBoost自适应增强
> set.seed(123)
> fit.adaboost <- train(class ~ ., method = "adaboost", data = dtrain, trControl = ctrl)
> res <- res %>%
+ bind_rows(tibble(model = "adaboost",
+ train_acc = mean(predict(fit.adaboost, newdata = dtrain,
+ type = "raw") == dtrain$class),
+ test_acc = mean(predict(fit.adaboost, newdata = dtest,
+ type = "raw") == dtest$class)))
> res
## # A tibble: 3 x 3
## model train_acc test_acc
##
## 1 glm 0.789 0.796
## 2 bag 0.997 0.879
## 3 adaboost 1 0.888
7、增强 - gbm随机梯度增强
> set.seed(123)
> fit.gbm <- train(class ~ ., method = "gbm", data = dtrain, trControl = ctrl)
> res <- res %>%
+ bind_rows(tibble(model = "gbm",
+ train_acc = mean(predict(fit.gbm, newdata = dtrain,
+ type = "raw") == dtrain$class),
+ test_acc = mean(predict(fit.gbm, newdata = dtest,
+ type = "raw") == dtest$class)))
> res
## # A tibble: 4 x 3
## model train_acc test_acc
##
## 1 glm 0.789 0.796
## 2 bag 0.997 0.879
## 3 adaboost 1 0.888
## 4 gbm 0.876 0.874
8、随机森林
随机森林是一种基于装袋决策树的非常流行和强大的算法。
> set.seed(123)
> fit.rf <- train(class ~ ., method = "rf", data = dtrain, trControl = ctrl)
> res <- res %>%
+ bind_rows(tibble(model = "rf",
+ train_acc = mean(predict(fit.rf, newdata = dtrain,
+ type = "raw") == dtrain$class),
+ test_acc = mean(predict(fit.rf, newdata = dtest,
+ type = "raw") == dtest$class)))
> res
## # A tibble: 5 x 3
## model train_acc test_acc
##
## 1 glm 0.789 0.796
## 2 bag 0.997 0.879
## 3 adaboost 1 0.888
## 4 gbm 0.876 0.874
## 5 rf 1 0.885
可以看到，所有集成模型的性能都优于单纯的逻辑回归模型。
而本实例中，随机梯度增强模型（gbm）在训练集和测试集上的准确度最接近，拟合效果较好，所以应该选择使用该模型。