集成算法简单介绍
以往我们接触过很多算法，而每种算法都有不同的使用领域，例如线性可分和线性不可分。在现实世界里，我们遇到的很多难题往往能用“集体智慧”、“专家汇集”等方式来解决或者更好的解决，那么在机器学习世界里，对于一个复杂的任务，我们能否将很多单一的机器学习算法组合在一起呢，计算出来的结果会比使用单一的算法性能更好吗？
集成学习方法就是这样一个思想，他是指通过多个模型的组合，来获得更好的效果，使集成的模型具有更强的泛化能力。
对同样的样本，集成算法用一些相对较弱的学习模型独立地进行训练，最后把结果整合起来进行整体预测。而其中主要难点在于究竟集成哪些独立的较弱的学习模型以及如何把学习结果整合起来。这是一类非常强大的，同时当下也非常流行的算法。
常见的算法包括：Boosting、Bagging、AdaBoost、堆叠泛化（Blending）、梯度推进机（GBM）、随机森林（Random Forest）。
集成算法这里不再做过多介绍，有兴趣的可以去看我另一篇文章。本文主要讲的是其中的随机森林、梯度推进机以及AdaBoost，针对同一组数据，他们如何实现？以及基于该特定数据，他们的效果对比。
操作
本文基于某电信运营商终端换机数据，本次算法实现我用的是R语言，本文重点放在后边算法的应用及比较上。
方案背景：当前智能手机终端已基本全面普及，且更新速度越来越快，全网通终端时代已经到来。结合用户终端使用习惯及偏好，向用户推荐最匹配终端，不仅可以提高用户体验，也可以加强用户的维系及保有 。
方案目的：综合用户基本属性信息、通信行为信息、终端使用信息、合约套餐信息、以及DPI相关数据，挖掘潜在换机用户，为后续开展终端营销相关活动提供支撑。
数据来源及指标展现
并行运算设置
library(doParallel)
cl <- makeCluster(10)
registerDoParallel(cl)读取数据，数据存储在oracle数据库
library(RJDBC)
drv <-JDBC("oracle.jdbc.driver.OracleDriver","/home/bigdata/ojdbc6.jar", identifier.quote="\"")
conn <- dbConnect(drv, "jdbc:oracle:thin:@***.***.**.***:****:******","用户名","密码")
data_t <- dbGetQuery(conn,"select * from TEMP_TERMINAL_USER where change_period = '提前换机'")数据查看
dim(data_t)
table(data_t$IF_HUANJI)
str(data_t)
sum(is.na(data_t))
sum(complete.cases(data_t))数据预处理
首先进行数据预处理，因为如何在这些字段中提取出模型要使用的特征变量决定了模型和算法的上限，首先删除标识指标，因为该指标除了提供用户统一标识，业务逻辑完全不可解释。
data_t<- data_t[!(names(data_t) %in% c("USER_NO"))]进行字段类型转化
for (i in c(2:4,6,7,10:11,15,16,21,23,32,34:40,43,67)) {
data_t[,i] <- as.factor(as.vector(data_t[,i]))
}
for (i in c(1,5,8,9,12:14,17:20,22,24:31,33,41,42,44:66)) {
data_t[,i] <- as.numeric(as.vector(data_t[,i]))
}缺失值查看
omit_num <- apply(data_t,2,function(x) sum(is.na(x)))
omit_rate <- apply(data_t,2,function(x) sum(is.na(x)/length(x)))
omit_rate <- data.frame(omit_rate)
omit_per_greater <- data.frame(omit_num)
omit_per_greater$omit_rate <- omit_rate$omit_rate
(omit_per_greater <- data.frame(omit_per_greater[omit_num > 0,]))删除值残缺严重变量，缺失率72.3%
data_t <- data_t[!(names(data_t) %in% c("BRAND_LOYALTY"))]删除单值变量
library(caret)
isZV <- apply(data_t, 2, function(x) length(unique(x)) == 1)
isZV[isZV==TRUE]
data_t <- data_t[, !isZV]由于本次数据稽核是在数据库里进行的，将数据从数据库读取到R之前已经针对缺失值、异常值等进行了初步处理，包括填充、插值和替换，而部分不满足处理条件的数据跳过，处理之后发现含有缺失值的记录仍占全部记录0.524%，因此本步骤针对含有缺失值的记录做删除处理
data_t <- na.omit(data_t)
sum(is.na(data_t))变量之间相关性分析
library(sampling)
data_sub1_cor <- strata(data_t,stratanames = "IF_HUANJI",size = c(b1,a1),method = "srswor")
data_t_sample_cor <- data_t[data_sub1_cor$ID_unit, ]
dim(data_t_sample_cor)
data_t1 <- data_t_sample_cor[,c(1,5,8,9,11:13,16:19,21,23:30,32,40,41,43:64)]
cor_data_t <- cor(data_t1)可视化
library(corrgram)
corrgram(data_t1,order=TRUE,lower.panel=panel.shade,upper.panel=panel.pie,text.panel=panel.txt,main="Correlogram of xc intercorrelations") 去除相关系数大于0.8的变量
library(caret)
cor_high_8 <- findCorrelation(cor_data_t,cutoff=0.8,verbose = TRUE,names = TRUE)
data_t <- data_t[!(names(data_t) %in% names(data_t1[,cor_high_8]))]基于随机森林的指标重要性评估
library(caret)
a1 = round(sum(data_t$IF_HUANJI == "1"))
b1 = round(1/8*sum(data_t$IF_HUANJI == "0")) #原比例1：40，平衡样本到1：5
library(sampling)
data_sub1 = strata(data_t,stratanames = "IF_HUANJI",size = c(b1/4,a1/4),method = "srswor")
data_sample = data_t[data_sub1$ID_unit, ]
library(randomForest)
n <- length(names(data_sample))
rate=1
for(i in 1:(n-1)){
set.seed(1234)
rf_train<-randomForest(as.factor(data_sample$IF_HUANJI)~.,data=data_sample,mtry=i,ntree=500)
rate[i]<-mean(rf_train$err.rate)
print(rf_train)
}
rate
rf_train<-randomForest(as.factor(data_sample$IF_HUANJI)~.,data=data_sample,mtry=12,ntree=1000,importance=TRUE)
plot(rf_train,col=1:1)
rf_train<-randomForest(as.factor(data_sample$IF_HUANJI)~.,data=data_sample,mtry=12,ntree=400,importance=TRUE,proximity=TRUE)
(importance<-importance(rf_train))
write.csv(importance,file="importance_huanji_t.csv",row.names=T,quote=F)
barplot(rf_train$importance[,1],main="输入变量重要性测度指标柱形图")
box()
importance(rf_train,type=1)
varImpPlot(x=rf_train,sort=TRUE,n.var=nrow(rf_train$importance),main="输入变量重要性测度散点图")数据按照月份往后平滑一月做测试数据，经过与上述训练数据同样处理后得到data_t_all_test，用以对模型进行检验
模型训练
1、随机森林模型
# 先分层抽
library(sampling)
data_sub1_RF = strata(data_t,stratanames = "IF_HUANJI",size = c(b1,a1),method = "srswor")
data_t_sample_RF = data_t[data_sub1_RF$ID_unit, ]
library(randomForest)
set.seed(100)
rf_model_t <- randomForest(as.factor(data_t_sample_RF$IF_HUANJI)~.,
data=data_t_sample_RF,
mtry=12,
ntree=400) 模型检验
data_t_all_prob <- NULL
data_t_all_prob$IF_HUANJI <- data_t_all_test$IF_HUANJI
data_t_all_prob$rf_model <- predict(rf_model_t, newdata = data_t_all_test,type="prob")[,2]
data_t_all_prob <- data.frame(data_t_all_prob)
data_t_all_prob$predict_rf <- ifelse(data_t_all_prob$rf_model > 0.74 ,1,0)
(RF_predict <- table(data_t_all_prob$IF_HUANJI,data_t_all_prob$predict_rf))
(accuracy <- RF_predict[2,2]/(RF_predict[1,2]+RF_predict[2,2]))
(Coverage <- RF_predict[2,2]/(RF_predict[2,1]+RF_predict[2,2])) 挖掘规模5.11万，命中率0.109，召回率0.027，F值0.043。
2、GBM模型
library(sampling)
data_sub1 = strata(data_t,stratanames = "IF_HUANJI",size = c(b1/3,a1/3),method = "srswor")
data_t_sample_gbm = data_t[data_sub1$ID_unit, ]
library(Metrics)
set.seed(200)
fitControl <- trainControl( method = "repeatedcv", number = 5, repeats = 5)
gbm_model_t <- train(IF_HUANJI~ .,
data = data_t_sample_gbm,
maximize = TRUE,
metric="Kappa",
method = "gbm",
trControl = fitControl,
na.action = na.omit)模型检验
data_t_all_prob$gbm_model <- predict(gbm_model_t, newdata=data_t_all_test,type="prob")[,2]
data_t_all_prob <- data.frame(data_t_all_prob)
data_t_all_prob$predict_gbm <- ifelse(data_t_all_prob$gbm_model > 0.73 ,1,0)
(gbm_predict <- table(data_t_all_prob$IF_HUANJI,data_t_all_prob$predict_gbm))
(accuracy <- gbm_predict[2,2]/(gbm_predict[1,2]+gbm_predict[2,2]))
(Coverage <- gbm_predict[2,2]/(gbm_predict[2,1]+gbm_predict[2,2])) 挖掘规模5.07万，命中率0.110，召回率0.029，F值0.046。
3、AdaBoost模型
library(sampling)
data_sub1_adaboost <- strata(data_t,stratanames = "IF_HUANJI",size = c(b1/4,a1/10),method = "srswor")
data_t_sample_adaboost <- data_t[data_sub1_adaboost$ID_unit, ]
library(ada)
set.seed(100)
adaboost_model_t <- train(IF_HUANJI~ ., data=data_t_sample_adaboost,
method = "ada",
trControl = ctrl,
metric = "kappa",
na.action = na.omit )
模型检验
data_t_all_prob$adaboost_model <- predict(adaboost_model_t, newdata = data_t_all_test,type="prob")[,2]
data_t_all_prob <- data.frame(data_t_all_prob)
data_t_all_prob$predict_adaboost <- ifelse(data_t_all_prob$adaboost_model > 0.69 ,1,0)
(adaboost_predict <- table(data_t_all_prob$IF_HUANJI,data_t_all_prob$predict_adaboos))
(accuracy <- adaboost_predict[2,2]/(adaboost_predict[1,2]+adaboost_predict[2,2]))
(Coverage <- adaboost_predict[2,2]/(adaboost_predict[2,1]+adaboost_predict[2,2]))挖掘规模4.98万，命中率0.111，召回率0.031，F值0.048。
从以上可以看出，分别对三个集成算法调整阈值，使得分别挖掘的用户规模在5万左右，对于该数据，对比效果可以看出三个算法：AdaBoost > GBM > 随机森林
模型再组合
专家投票法，每个集成算法为一票，三个专家针对每个个体投票，得两票及以上判定为‘1’，否则为‘0’
data_t_all_prob$predict_rf1 <- ifelse(data_t_all_prob$rf_model > 0.72 ,1,0)
data_t_all_prob$predict_gbm1 <- ifelse(data_t_all_prob$gbm_model > 0.72 ,1,0)
data_t_all_prob$predict_adaboost1 <- ifelse(data_t_all_prob$adaboost_model > 0.69 ,1,0)
data_t_all_prob$sum <- apply(data_t_all_prob[,c(8,9,10)],1,sum)
data_t_all_prob$predict <- ifelse(data_t_all_prob$sum >=2,"1","0")
data_t_all_prob <- data.frame(data_t_all_prob)
table(data_t_all_prob$IF_HUANJI,data_t_all_prob$predict)
(logit_predict <- table(data_t_all_prob$IF_HUANJI,data_t_all_prob$predict))
logit_predict[2,2]/(logit_predict[1,2]+logit_predict[2,2])
logit_predict[2,2]/(logit_predict[2,1]+logit_predict[2,2])挖掘规模4.96万，命中率0.114，召回率0.033，F值0.051。
同样挖掘5万用户，可以看出组合后的模型效果又有了提升。
