游戏用户流失预测数据分析
作者：人和六栋
博客专栏：
https://ask.hellobi.com/blog/renhe6dong
练习数据来源
谢佳标老师R语言游戏数据分析和挖掘中的第8章：用户流失预测数据.csv
【点击阅读原文可直接购买：R语言游戏数据分析与挖掘】
数据分析方法
使用各种分类算法（二元logistic回归、决策树、随机森林、人工神经网络）
分析步骤
按照谢老师文章中的步骤，依次为：
步骤1：数据转换：增加周活跃度和玩牌胜率等衍生指标。周活跃度＝登录总次数/7；玩牌胜率＝赢牌局数/玩牌局数;玩牌负率＝输牌局数/玩牌局数。
步骤2：变量相关性分析：考虑因子变量的哑变量处理
步骤3：10折交叉验证进行模型优化参数选择
步骤4：构建决策树、随机森林、人工神经网络构建三种分类模型，并比较各分类器结果，选择最优分类器。
分析
##导入数据
说明：共1309条记录，13个字段。数据已经经过清洗，无缺失值，且变量属性无需修改。
> userchurn<-read.csv("E:\\R语言\\Game_DataMining_With_R-master\\data\\第8章\\用户流失预测数据.csv",header=T)
> 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)
用户id 是否流失 性别 登录总次数 站内好友数
Min. : 1 否: 291 男:1057 Min. : 2.00 Min. : 0.000
1st Qu.: 328 是:1018 女: 252 1st Qu.: 2.00 1st Qu.: 0.000
Median : 655 Median : 2.00 Median : 1.000
Mean : 655 Mean : 2.81 Mean : 1.341
3rd Qu.: 982 3rd Qu.: 3.00 3rd Qu.: 2.000
Max. :1309 Max. :11.00 Max. :22.000
等级 积分 玩牌局数 赢牌局数
Min. : 0.000 Min. : 0.000 Min. : 1.0 Min. : 1.00
1st Qu.: 3.000 1st Qu.: 0.000 1st Qu.: 8.0 1st Qu.: 2.00
Median : 4.000 Median : 0.000 Median : 23.0 Median : 7.00
Mean : 4.361 Mean : 7.257 Mean : 104.4 Mean : 26.53
3rd Qu.: 5.000 3rd Qu.: 5.000 3rd Qu.: 63.0 3rd Qu.: 19.00
Max. :16.000 Max. :595.000 Max. :7215.0 Max. :2023.00
输牌局数 正常牌局 非正常牌局 最高牌类型
Min. : 0.00 Min. : 0.0 Min. : 0.000 Min. : 0.000
1st Qu.: 0.00 1st Qu.: 8.0 1st Qu.: 0.000 1st Qu.: 0.000
Median : 0.00 Median : 22.0 Median : 0.000 Median : 0.000
Mean : 69.05 Mean : 110.2 Mean : 1.483 Mean : 3.475
3rd Qu.: 29.00 3rd Qu.: 63.0 3rd Qu.: 0.000 3rd Qu.: 8.000
Max. :6568.00 Max. :12425.0 Max. :284.000 Max. :11.000
##变量转换
> ##变量转换
> 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")
##相关性分析
> library(caret)
> userchurn_dummy<-dummyVars(~.,data=userchurn)
> userchurn_dummy_pre<-as.data.frame(predict(userchurn_dummy,userchurn))
> str(userchurn_dummy_pre)
'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 ...
##构建相关矩阵
说明：可以看出用户流失除了与性别不相关外，和其他变量都相关，其中和登录总数、周活跃度、最高牌类型、玩牌负率、等级相关性比较高
> cor<-cor(userchurn_dummy_pre[,2:3],userchurn_dummy_pre[,-c(1:3)])##本次分析主要是看是否流失字段与其他变量之间的相关性，所以需要筛选
> library(corrplot)
> corrplot(cor,method="ellipse")
##筛选变量
说明：由于周活跃度、玩牌胜率是通过其他字段转换而来，所以和涉及的字段存在着很强相关性。在后续的分析中，与谢老师分析的不一样的是，我直接剔除了登录总数、玩牌局数以及赢牌局数，输牌局数。
> user_select<-userchurn[,-c(1,4,8,9,10)]
##数据分区
训练集：测试集=7:3
> library(caret)
> 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)
#c5.0模型参数选择
> library(C50)
> library(plyr)
> c5.0_train<-train(是否流失~.,data=train_data,method="C5.0",trControl=control)
说明：最优模型参数选择：trials = 1, model = rules and winnow= TRUE。
> c5.0_train
C5.0
917 samples
10 predictor
2 classes: '0', '1'
No pre-processing
Resampling: Cross-Validated (10 fold, repeated 3 times)
Summary of sample sizes: 824, 826, 826, 825, 826, 824, ...
Resampling results across tuning parameters:
model winnow trials Accuracy Kappa
rules FALSE 1 0.9197142 0.7703119
rules FALSE 10 0.9215339 0.7724119
rules FALSE 20 0.9193676 0.7667339
rules TRUE 1 0.9269606 0.7795767
rules TRUE 10 0.9164135 0.7518620
rules TRUE 20 0.9189300 0.7622875
tree FALSE 1 0.9255352 0.7854662
tree FALSE 10 0.9120892 0.7514866
tree FALSE 20 0.9145977 0.7562199
tree TRUE 1 0.9247787 0.7758407
tree TRUE 10 0.9185757 0.7670737
tree TRUE 20 0.9134872 0.7519007
Accuracy was used to select the optimal model using the largest value.
The final values used for the model were trials = 1, model = rules and winnow
= TRUE.
#randomForest模型参数
选择说明：最优模型参数选择：mtry = 6
> 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: 826, 824, 825, 826, 825, 824, ...
Resampling results across tuning parameters:
mtry Accuracy Kappa
2 0.9127843 0.7476679
6 0.9200548 0.7704936
10 0.9189798 0.7688598
Accuracy was used to select the optimal model using the largest value.
The final value used for the model was mtry = 6.
#nnet模型参数选择
说明：最优模型参数选择：size = 1 and decay = 0.1
> 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: 825, 825, 826, 826, 826, 824, ...
Resampling results across tuning parameters:
size decay Accuracy Kappa
1 0e+00 0.8698903 0.5516198
1 1e-04 0.8653639 0.4981789
1 1e-01 0.9153212 0.7446841
3 0e+00 0.9029149 0.7366187
3 1e-04 0.9010198 0.7164779
3 1e-01 0.9124069 0.7422376
5 0e+00 0.9029703 0.7178035
5 1e-04 0.9044032 0.7303573
5 1e-01 0.9098426 0.7375306
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.
##模型构建
#构建c5.0决策树模型
> fit_c5.0<-C5.0(是否流失~.,data=train_data,trails=1,rules=T,control=C5.0Control(winnow = TRUE))
> summary(fit_c5.0)
Call:
C5.0.formula(formula = 是否流失 ~ ., data = train_data, trails = 1, rules =
T, control = C5.0Control(winnow = TRUE))
C5.0 [Release 2.07 GPL Edition] Thu Aug 03 20:39:16 2017
-------------------------------
Class specified by attribute `outcome'
Read 917 cases (11 attributes) from undefined.data
3 attributes winnowed
Estimated importance of remaining attributes:
176% 周活跃度
16% 站内好友数
11% 积分
8% 正常牌局
<1% 性别
<1% 非正常牌局
<1% 最高牌类型
Rules:
Rule 1: (5, lift 3.9)
站内好友数 > 0
站内好友数 <= 2
积分 <= 6
正常牌局 <= 8
周活跃度 > 0.286
-> class 0 [0.857]
Rule 2: (292/88, lift 3.1)
周活跃度 > 0.286
-> class 0 [0.697]
Rule 3: (625, lift 1.3)
周活跃度 <= 0.286
-> class 1 [0.998]
Rule 4: (621/26, lift 1.2)
站内好友数 <= 2
积分 <= 5
-> class 1 [0.957]
Default class: 1
Evaluation on training data (917 cases):
Rules
----------------
No Errors
4 60( 6.5%) <<
(a) (b) <-classified as
---- ----
183 21 (a): class 0
39 674 (b): class 1
Attribute usage:
100.00% 周活跃度
67.72% 站内好友数
67.72% 积分
0.55% 正常牌局
> ##训练集预测
> 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
Confusion Matrix and Statistics
Reference
Prediction 0 1
0 74 17
1 13 288
Accuracy : 0.9235
95% CI : (0.8925, 0.9478)
No Information Rate : 0.7781
P-Value [Acc > NIR] : 9.13e-15
Kappa : 0.782
Mcnemar's Test P-Value : 0.5839
Sensitivity : 0.8506
Specificity : 0.9443
Pos Pred Value : 0.8132
Neg Pred Value : 0.9568
Prevalence : 0.2219
Detection Rate : 0.1888
Detection Prevalence : 0.2321
Balanced Accuracy : 0.8974
'Positive' Class : 0
#构建随机森林
说明：对于模型构建最重要的变量依次为：周活跃率、积分、玩牌负率、正常牌局、玩牌胜率
> library(randomForest)
> fit_randomForest<-randomForest(是否流失~.,data=train_data,mtry=6)
> importance(fit_randomForest)
MeanDecreaseGini
性别 1.924600
站内好友数 9.544445
等级 6.067091
积分 69.063727
正常牌局 19.967124
非正常牌局 3.097177
最高牌类型 7.810529
周活跃度 152.745122
玩牌胜率 19.573530
玩牌负率 29.008260
> varImpPlot(fit_randomForest)
> ##训练集预测
> pre_randomForest_train<-predict(fit_randomForest,train_data,type="class")
> ##测试集预测
> pre_randomForest_test<-predict(fit_randomForest,test_data,type="class")
#神经网络模型构建
> 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")
#二元Logistic回归建模
> fit_Logistic<-glm(是否流失~., train_data,family=binomial())
>step_logistic<-step(fit_Logistic)
说明：使用step逐步回归后，得到的AIC=286.71，最终选入正常牌局 、 最高牌类型 、 周活跃度三个字段
> summary(step_logistic)
Call:
glm(formula = 是否流失 ~ 正常牌局 + 最高牌类型 + 周活跃度, family = binomial(),
data = train_data)
Deviance Residuals:
Min 1Q Median 3Q Max
-1.9260 0.1362 0.1400 0.1842 3.2236
Coefficients:
Estimate Std. Error z value Pr(>|z|)
(Intercept) 1.052e+01 7.890e-01 13.331 < 2e-16 ***
正常牌局 1.414e-03 3.697e-04 3.826 0.00013 ***
最高牌类型 -1.359e-01 5.779e-02 -2.352 0.01865 *
周活跃度 -2.066e+01 2.017e+00 -10.242 < 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: 972.04 on 916 degrees of freedom
Residual deviance: 278.71 on 913 degrees of freedom
AIC: 286.71
Number of Fisher Scoring iterations: 7
说明：logistic原始模型与step回归后模型比较，P值=0.8026，说明逐步回归后得到的模型效度并没有显著降低原始模型的效度。
> 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 274.92
2 913 278.71 -7 -3.7987 0.8026
ROC曲线进行模型评估，找出训练集最优阈值
说明：训练集最优阈值是0.844，TPR=0.878，FPR=1，AUC=0.980
> 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.thr
49 30898 49 15289 0 0 4360 0 0:00:07 0:00:03 0:00:04 4359es=TRUE)
> ##说明：最优阈值是0.844，TPR=0.878，FPR=1，AUC=0.980
> pre_logistic_train=ifelse(pre_logistic_train>0.844,1,0)
ROC曲线进行模型评估，找出测试集最优阈值
说明：测试集最优阈值是0.779，TPR=0.898，FPR=1，AUC=0.981
> 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)
##所有模型训练集及测试集预测结果比较
说明：各模型的不管是train_data还是test_data，Accuracy都在90%以上，效果非常好。训练集中，随机森林的预测效果竟达到100%，其中：
c5.0:train-test=0.935-0.923=0.012
randomForest:train-test=1-0.921=0.079
nnet:train-test=0.923-0.921=0.02
logistic:train-test=0.905-0.921=-0.016
前三个的训练集效果均好与测试集，最后训练集效果反而小于测试集，但是除了随机森林前后预测效果差距比较大之外，其余的差距并不大。需要考虑随机森林是否过拟合。
> 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(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
Accuracy Kappa Sensitivity Specificity Precision
t_c5.0 0.935 0.817 0.897 0.945 0.824
t_randomForest 1.000 1.000 1.000 1.000 1.000
t_nnet 0.923 0.767 0.770 0.966 0.867
t_logistic 0.905 0.762 1.000 0.878 0.701
Accuracy Kappa Sensitivity Specificity Precision
t_c5.0 0.923 0.782 0.851 0.944 0.813
t_randomForest 0.921 0.776 0.851 0.941 0.804
t_nnet 0.921 0.758 0.747 0.970 0.878
t_logistic 0.921 0.797 1.000 0.898 0.737
> names(train_table)=names(test_table)<-name
> train_table;test_table
$t_c5.0
Reference
Prediction 0 1
0 183 39
1 21 674
$t_randomForest
Reference
Prediction 0 1
0 204 0
1 0 713
$t_nnet
Reference
Prediction 0 1
0 157 24
1 47 689
$t_logistic
Reference
Prediction 0 1
0 204 87
1 0 626
$t_c5.0
Reference
Prediction 0 1
0 74 17
1 13 288
$t_randomForest
Reference
Prediction 0 1
0 74 18
1 13 287
$t_nnet
Reference
Prediction 0 1
0 65 9
1 22 296
$t_logistic
Reference
Prediction 0 1
0 87 31
1 0 274
#随机森林过拟合诊断（以下均为谢老师书中的R代码）
随机森林默认决策树数目为500，接着分别计算不同数目下的误差率。
> n=500
> nerr_train=nerr_test<-rep(0,n)
> for(i in 1:n){
+ fit<-randomForest(是否流失~.,data=train_data,mtry=6,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)
+ nerr_test[i]<-sum(test_data$是否流失!=test)/nrow(test_data)
+ }
> plot(1:n,nerr_train,type = "l",ylim = c(min(nerr_train,nerr_test),max(nerr_train,nerr_test)),xlab="数的数目",ylab="误差率",lty=1,col=1)
> lines(1:n,nerr_test,lty=2,col=2)
> legend("right",lty=1:2,col=1:2,legend =c("训练集","测试集"),bty="n",cex=0.8)
微信回复关键字即可学习
回复 R R语言快速入门免费视频
回复 统计 统计方法及其在R中的实现
回复 用户画像 民生银行客户画像搭建与应用
回复 大数据 大数据系列免费视频教程
回复 可视化 利用R语言做数据可视化
回复 数据挖掘 数据挖掘算法原理解释与应用
回复 机器学习 R&Python机器学习入门