之前看的关于客户流失预警R语言实现的文章，这里做下整理
这里是一个关于游戏客户的例子。
步骤1：数据转换：增加周活跃度和玩牌胜率等衍生指标。
周活跃度＝登录总次数/7；玩牌胜率＝赢牌局数/玩牌局数;玩牌负率＝输牌局数/玩牌局数。
步骤2：变量相关性分析：考虑因子变量的哑变量处理
步骤3：10折交叉验证进行模型优化参数选择
步骤4：构建决策树、随机森林、人工神经网络构建三种分类模型，并比较各分类器结果，选择最优分类器。
导入数据
userchurn <- read.csv("D:/Rdata/用户流失预测数据.csv",header=T,fileEncoding = "UTF-8")
str(userchurn)
对数据有一个大概的了解：
'data.frame': 1309 obs. of 13 variables:
$ 用户id : int 1 2 3 4 5 6 7 8 9 10 ...
$ 是否流失 : Factor w/ 2 levels "否","是": 2 1 1 2 2 2 1 2 2 1 ...
$ 性别 : Factor w/ 2 levels "男","女": 1 1 1 1 1 1 1 1 1 1 ...
$ 登录总次数: int 2 3 3 2 2 2 7 2 2 6 ...
$ 站内好友数: int 1 5 1 0 1 0 1 0 0 0 ...
$ 等级 : int 4 6 7 4 4 4 6 3 4 3 ...
$ 积分 : int 0 5 8 0 0 0 26 0 0 20 ...
$ 玩牌局数 : int 27 83 209 15 30 18 65 10 15 6 ...
$ 赢牌局数 : int 4 40 56 4 3 8 10 3 8 2 ...
$ 输牌局数 : int 0 43 153 0 0 0 55 0 7 4 ...
$ 正常牌局 : int 0 11 0 16 30 18 64 10 15 6 ...
$ 非正常牌局: int 0 0 0 0 0 0 1 0 0 0 ...
$ 最高牌类型: int 0 7 8 0 0 0 7 0 8 4 ...
汇总数据
summary(userchurn)
变量转换
userchurn$周活跃度 <- round(userchurn$登录总次数/7,3)
userchurn$玩牌胜率 <- round(userchurn$赢牌局数/userchurn$玩牌局数,3)
userchurn$玩牌负率 <- round(userchurn$输牌局数/userchurn$玩牌局数,3)
如果电脑对中文不太友好，后续建模时总是出现警告，所以尽量将汉字字符改为英文字符，字段名则不需要改。
levels(userchurn$是否流失) <- c("0","1") # 0表示不会 1表示会
levels(userchurn$性别) <- c("M","F")
相关性分析
1.哑变量处理
library(caret) #这里用到caret包
userchurn_dummy <- dummyVars(~.,data=userchurn) #dummyVars函数
userchurn_dummy_pre <- as.data.frame(predict(userchurn_dummy,userchurn))
str(userchurn_dummy_pre)
查看userchurn_dummy_pre，注意是否流失和性别字段已经处理为哑变量。这里可以看下caret包中dummyVars函数的用法。
'data.frame': 1309 obs. of 18 variables:
$ 用户id : num 1 2 3 4 5 6 7 8 9 10 ...
$ 是否流失.0: num 0 1 1 0 0 0 1 0 0 1 ...
$ 是否流失.1: num 1 0 0 1 1 1 0 1 1 0 ...
$ 性别.M : num 1 1 1 1 1 1 1 1 1 1 ...
$ 性别.F : num 0 0 0 0 0 0 0 0 0 0 ...
$ 登录总次数: num 2 3 3 2 2 2 7 2 2 6 ...
$ 站内好友数: num 1 5 1 0 1 0 1 0 0 0 ...
$ 等级 : num 4 6 7 4 4 4 6 3 4 3 ...
$ 积分 : num 0 5 8 0 0 0 26 0 0 20 ...
$ 玩牌局数 : num 27 83 209 15 30 18 65 10 15 6 ...
$ 赢牌局数 : num 4 40 56 4 3 8 10 3 8 2 ...
$ 输牌局数 : num 0 43 153 0 0 0 55 0 7 4 ...
$ 正常牌局 : num 0 11 0 16 30 18 64 10 15 6 ...
$ 非正常牌局: num 0 0 0 0 0 0 1 0 0 0 ...
$ 最高牌类型: num 0 7 8 0 0 0 7 0 8 4 ...
$ 周活跃度 : num 0.286 0.429 0.429 0.286 0.286 0.286 1 0.286 0.286 0.857 ...
$ 玩牌胜率 : num 0.148 0.482 0.268 0.267 0.1 0.444 0.154 0.3 0.533 0.333 ...
$ 玩牌负率 : num 0 0.518 0.732 0 0 0 0.846 0 0.467 0.667 ...
head(userchurn_dummy_pre)
用户id 是否流失.0 是否流失.1 性别.M 性别.F 登录总次数 站内好友数 等级 积分 玩牌局数
1 1 0 1 1 0 2 1 4 0 27
2 2 1 0 1 0 3 5 6 5 83
3 3 1 0 1 0 3 1 7 8 209
4 4 0 1 1 0 2 0 4 0 15
5 5 0 1 1 0 2 1 4 0 30
6 6 0 1 1 0 2 0 4 0 18
赢牌局数 输牌局数 正常牌局 非正常牌局 最高牌类型 周活跃度 玩牌胜率 玩牌负率
1 4 0 0 0 0 0.286 0.148 0.000
2 40 43 11 0 7 0.429 0.482 0.518
3 56 153 0 0 8 0.429 0.268 0.732
4 4 0 16 0 0 0.286 0.267 0.000
5 3 0 30 0 0 0.286 0.100 0.000
6 8 0 18 0 0 0.286 0.444 0.000
2.构建相关矩阵
参照head(userchurn_dummy_pre)的结果，本次分析主要看是否流失字段与其他变量之间的相关性，进行变量筛选
cor <- cor(userchurn_dummy_pre[,2:3],userchurn_dummy_pre[,-c(1:3)])
library(corrplot) #加载corrplot包进行相关系数可视化绘图
corrplot(cor,method = "ellipse")
image.png
关于corrplot函数可以查看下帮助文档，参数的不同，图形各有不同。
筛选变量
说明：由于周活跃度、玩牌胜率是通过其他字段转换而来，所以和涉及的字段存在着很强相关性。在后续的分析中，直接提出登录总数、玩牌局数以及赢牌局数，输牌局数等字段。
user_select <- userchurn[,-c(1,4,8,9,10)]
数据分区
这里依旧使用caret包进行数据分区train和test
训练集：测试集 = 7:3
library(caret)
#createDataPartition函数
ind <- createDataPartition(user_select$是否流失,times=1,p=0.7,list=F)
train_data <- user_select[ind,]
test_data <- user_select[-ind,]
10折交叉验证选择模型优化参数
control <- trainControl(method = "repeatedcv",number = 10,repeats = 3) #control参数
参数选择
1.c5.0模型参数选择
library(C50) #载入包
library(plyr)
c5.0_train <- train(是否流失~.,data=train_data,method="C5.0",trControl=control) #trControl参数
c5.0_train #查看c5.0_train
说明：最优模型参数选择：trials = 1, model = rules and winnow= TRUE。
实际上我操作进行到这一步报错。
2.randomForest模型参数选择
randomForest_train <- train(是否流失~.,data=train_data,method="rf",trControl=control)
randomForest_train
Random Forest
917 samples
10 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (10 fold, repeated 3 times)
Summary of sample sizes: 825, 826, 826, 825, 825, 825, ...
Resampling results across tuning parameters:
mtry Accuracy Kappa
2 0.9105756 0.7421707
6 0.9138680 0.7536644
10 0.9153253 0.7579955
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was mtry = 10.
说明：最优模型参数选择：mtry = 10.
3.nnet模型参数选择
nnet_train <- train(是否流失~.,data=train_data,method="nnet",trControl=control)
nnet_train
Neural Network
917 samples
10 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (10 fold, repeated 3 times)
Summary of sample sizes: 824, 825, 826, 825, 826, 826, ...
Resampling results across tuning parameters:
size decay Accuracy Kappa
1 0e+00 0.8720939 0.5659623
1 1e-04 0.8652216 0.5045500
1 1e-01 0.9102098 0.7365093
3 0e+00 0.9098476 0.7363634
3 1e-04 0.9087721 0.7467049
3 1e-01 0.9076578 0.7329202
5 0e+00 0.9029792 0.7197735
5 1e-04 0.9033057 0.7308654
5 1e-01 0.9095207 0.7427693
Accuracy was used to select the optimal model using the largest value.
The final values used for the model were size = 1 and decay = 0.1.
说明：The final values used for the model were size = 1 and decay = 0.1.
最优模型参数选择：size=1,decay=0.1
模型构建
1.构建c5.0决策树模型
fit_c5.0<-C5.0(是否流失~.,data=train_data,trails=1,rules=T,control=C5.0Control(winnow = TRUE))
summary(fit_c5.0)
#训练集预测
pre_c5.0_train <- predict(fit_c5.0,train_data,type = "class")
#测试集预测
pre_c5.0_test<-predict(fit_c5.0,test_data,type="class")
对测试集，混淆矩阵给出交叉表的各个指标值
t_c5.0_test <- confusionMatrix(pre_c5.0_test,test_data$是否流失)
t_c5.0_test
2.构建随机森林
library(randomForest)
fit_randomForest <- randomForest(是否流失~.,data=train_data,mtry=10)
importance(fit_randomForest)
MeanDecreaseGini
性别 1.128984
站内好友数 7.962122
等级 3.738560
积分 23.817588
正常牌局 17.195930
非正常牌局 3.638428
最高牌类型 7.183903
周活跃度 213.553340
玩牌胜率 22.276951
玩牌负率 16.425345
画图 varImpPlot()
varImpPlot(fit_randomForest) #randomForest包的函数
image.png
说明：对于模型构建最重要的变量为：周活跃率、积分、玩牌负率、正常牌局、玩牌胜率
训练集预测
pre_randomForest_train <- predict(fit_randomForest,train_data,type = "class")
测试集预测
pre_randomForest_test <- predict(fit_randomForest,test_data,type = "class")
3.神经网络模型构建
library(nnet)
fit_nnet <- nnet(train_data$是否流失~.,train_data,size=1,range=0.1,decay=0.1,maxit=200)
# 训练集预测
pre_nnet_train <- predict(fit_nnet,train_data,type="class")
# 预测集预测
pre_nnet_test <- predict(fit_nnet,test_data,type="class")
4.二元Logistic回归建模
对Logistic模型的应用使用stats包中自带的glm()函数
#glm建模
fit_Logistic <- glm(是否流失~.,train_data,family=binomial())
#使用step逐步回归
step_logistic <- step(fit_Logistic)
...
Step: AIC=283.03
是否流失 ~ 正常牌局 + 最高牌类型 + 周活跃度
Df Deviance AIC
<none> 275.03 283.03
- 正常牌局 1 282.44 288.44
- 最高牌类型 1 284.72 290.72
- 周活跃度 1 623.27 629.27
summary(step_logistic)
Call:
glm(formula = 是否流失 ~ 积分 + 正常牌局 + 最高牌类型 + 周活跃度,
family = binomial(), data = train_data)
Deviance Residuals:
Min 1Q Median 3Q Max
-2.2231 0.1318 0.1386 0.1988 3.2179
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 9.491e+00 8.533e-01 11.123 < 2e-16 ***
积分 -8.766e-02 4.765e-02 -1.840 0.065840 .
正常牌局 3.157e-03 9.274e-04 3.404 0.000663 ***
最高牌类型 -1.838e-01 5.803e-02 -3.168 0.001533 **
周活跃度 -1.705e+01 2.379e+00 -7.168 7.6e-13 ***
---
Signif. codes:
0 ‘***’ 0.001 ‘**’ 0.01 ‘*’ 0.05 ‘.’ 0.1 ‘ ’ 1
(Dispersion parameter for binomial family taken to be 1)
Null deviance: 972.04 on 916 degrees of freedom
Residual deviance: 296.95 on 912 degrees of freedom
AIC: 306.95
Number of Fisher Scoring iterations: 9
使用step逐步回归后，得到的AIC=306.95，最终选入正常牌局 、 最高牌类型 、 周活跃度三个字段
比较原始模型和逐步回归模型：
anova(fit_Logistic,step_logistic,test = "Chisq")
Analysis of Deviance Table
Model 1: 是否流失 ~ 性别 + 站内好友数 + 等级 + 积分 + 正常牌局 + 非正常牌局 +
最高牌类型 + 周活跃度 + 玩牌胜率 + 玩牌负率
Model 2: 是否流失 ~ 正常牌局 + 最高牌类型 + 周活跃度
Resid. Df Resid. Dev Df Deviance Pr(>Chi)
1 906 269.71
2 913 275.03 -7 -5.3241 0.6205
ROC曲线进行模型评估，找出训练集最优阈值
- 对train_data
pre_logistic_train <- predict(step_logistic,train_data,type = "response")
library(pROC)
fit_roc_train <- roc(train_data$是否流失,pre_logistic_train)
plot(fit_roc_train,print.auc=TRUE,auc.polygon=TRUE,max.auc.polygon=TRUE,auc.polygon.col="skyblue",print.thres=TRUE)
pre_logistic_train=ifelse(pre_logistic_train>0.931,1,0)
image.png
- 对test_data
pre_logistic_test<-predict(step_logistic,test_data,type="response")
library(pROC)
fit_roc_test<-roc(test_data$是否流失,pre_logistic_test)
plot(fit_roc_test,print.auc=TRUE,auc.polygon=TRUE,max.auc.polygon=TRUE,auc.polygon.col="skyblue",print.thres=TRUE)
pre_logistic_test=ifelse(pre_logistic_test>0.779,1,0)
image.png
所有模型训练集及测试集预测结果比较
1.训练模型及结果比较
#定义相关名称和数据集
name <- c("t_c5.0","t_randomForest","t_nnet","t_logistic")
test_table=train_table=list()
compare_test=compare_train <- as.data.frame(matrix(rep(0,20),nrow = 4))
rownames(compare_test) =rownames(compare_train) <- name
colnames(compare_test)=colnames(compare_train) <- c("Accuracy","Kappa","Sensitivity","Specificity","Precision")
#一个for循环 混淆矩阵confusionMatrix
for(i in 1:4){
t_train <- confusionMatrix(switch(i,pre_c5.0_train,pre_randomForest_train,pre_nnet_train,pre_logistic_train),train_data$是否流失)
t_test<-confusionMatrix(switch(i,pre_c5.0_test,pre_randomForest_test,pre_nnet_test,pre_logistic_test),test_data$是否流失)
compare_train[i,]<-round((t(c(t_train$overall[1:2],t_train$byClass[c(1,2,5)]))),3)
compare_test[i,]<-round((t(c(t_test$overall[1:2],t_test$byClass[c(1,2,5)]))),3)
train_table[[i]]<-t_train$table
test_table[[i]]<-t_test$table
}
compare_train;compare_test
names(train_table)=names(test_table) <- name
train_table;test_table
2.随机森林过拟合诊断
随机森林默认决策树数目为500，接着分别计算不同数目下的误差率。
n=500
#创建空的nerr_train和nerr_test
nerr_train=nerr_test <- rep(0,n)
#这里用nerr_train=nerr_test<-c()也可以 为了之后放误差率的
#for循环
for(i in 1:n){
fit <- randomForest(是否流失~.,data=train_data,mtry=10,ntree=i)
train <- predict(fit,train_data,type="class")
test <- predict(fit,test_data,type="class")
nerr_train[i] <- sum(train_data$是否流失!=train/nrow(train_data))
neer_test[i] <- sum(test_data$是否流失!=test/nrow(test_data))
}
#作图nerr_train
plot(1:n,nerr_train,type = "1",ylim = c(min(nerr_train,nerr_test),max(nerr_train,nerr_test)),
xlab = "树的数目",ylab = "误差率",lty=1,col=1)
#nerr_test
lines(1:n,nerr_test,lty=2,col=2)
#添加图例
legend("right",lty = 1:2,col = 1:2,legend=c("训练集","测试集"),bty="n",cex=0.8)
Rplot.png
图形给出了随机森林的ntree取不同数值时，训练集与测试集的误差大小，随着取值不断增大，训练集误差在0处稳定，测试集误差波动幅度不断减小，在0.075左右上下波动。可见，随机森林对结果的预测并非过拟合。
