《重在实战!十五大案例,开启R语言实战之门金钥匙》即将起航

浏览: 2675

社区有很多自学或者上过一些R语言的课程,掌握了R语言的用法,懂得调用函数实现某些算法。但是却缺少一些实际生产数据,对于如何将原始数据转化成能建模的数据还是缺少实战经验。下周二开启的《重在实战!十五大案例,开启R语言实战之门金钥匙》课程是从实际案例出发,结合自己多年在数据分析和挖掘领域的行业经验,尽量让学习者能少踩一些坑,能利用正确的数据处理技巧在生产数据中得到有价值的知识,进而为业务进行数据支持。本课程虽然以7月即将出版的新书《R语言游戏数据分析与挖掘》的章节为大纲,每次授课均是以某一个实际业务背景出发,利用R语言对数据进行清洗和转化,并选择正确的建模方法发现知识。不过这些案例均具有其他行业通用性,主要围绕企业最关心的收入和用户两个核心话题展开,所以其中的思路和方法可以很好地移植到其他行业中去。之前学习过R语言十三式的学员,可以接着学习本课程,刚好检验大家之前的学习效果和知识迁移能力。不过案例中用到的R的基本知识和常用算法也会在课上再次讲解,让那些没有学过R语言十三式的学员也能学起来没有太大的压力。下面将三个在实战中会出现的三个小知识提前剧透。

  • 一、数据处理能力

先拿我们最常用的数据处理来说,大家在之前的学习中已经掌握了常用的数据抽样、数据转换、哑变量处理和类失衡处理的技巧。但是当大家拿到生产数据时是否在建模前能否想到利用这些方法呢?这边就拿最简单的数据转换举例来说,假设现在有一份数据转换的数据,包括了playerid(用户id)、registration(注册日期)、firstpaydate(第一次付费日期)、days(登录天数)和lifetime(生命周期)等属性。记下来,我们需要利用现有属性生成是否付费以及是否新增首日付费两个衍生变量。首先,我们将数据导入到R中,由于firstpaydate属性有大量的缺失值,所以需要设置na.strings = NA。执行以下代码:

> # 导入数据
> rawdata <- read.csv("数据转换数据.csv",na.strings = NA)
> # 查看数据的前六行
> head(rawdata)
playerid registration firstpaydate days lifetime
1 1001984428 20160408 NA 4 101
2 1002360742 20160407 20160407 12 16
3 1003943907 20160423 NA 1 1
4 100500571 20160406 20160407 10 101
5 1005541598 20160414 NA 1 1
6 1007334849 20160426 NA 2 2

由于注册日期和首次付费日期非日期格式,接下来对这两个属性的格式进行转换。执行以下代码:

> # 将注册日期变量转换成日期格式
> rawdata$registration <-as.Date(paste(substr(rawdata$registration,1,4),
+                              substr(rawdata$registration,5,6),
+                               substr(rawdata$registration,7,8),
+                              sep="/"),
+                             "%Y/%m/%d")
> # 将首次付费日期转换成日期格式
> rawdata$firstpaydate <-as.Date(paste(substr(rawdata$firstpaydate,1,4),
+                                 substr(rawdata$firstpaydate,5,6),
+                                substr(rawdata$firstpaydate,7,8),
+                                 sep="/"),
+                                "%Y/%m/%d")
> # 查看数据的前六行
> head(rawdata)
   playerid registration firstpaydate days lifetime
1 1001984428   2016-04-08         <NA>    4     101
2 1002360742   2016-04-07  2016-04-07   12       16
3 1003943907   2016-04-23         <NA>    1       1
4 100500571   2016-04-06   2016-04-07  10      101
5 1005541598   2016-04-14         <NA>    1       1
6 1007334849   2016-04-26         <NA>    2       2

最后,我们增加ispay变量:0-非付费用户、1-付费用户;isnewpay变量:0-非新增付费用户、1-新增首日付费用户。执行以下代码:

> # 增加ispay变量:0表示非付费用户,1表示付费用户
> rawdata$ispay <- ifelse(!is.na(rawdata$firstpaydate),1,0)
> # 增加isnewpay变量:0表示非新增首日付费用户,1表示新增首日付费用户
> rawdata$isnewpay <- ifelse(rawdata$registration==rawdata$firstpaydate,
+ 1,0)
> rawdata[is.na(rawdata$isnewpay),'isnewpay'] <- 0
> # 查看数据前10行
> head(rawdata)
playerid registration firstpaydate days lifetime ispay isnewpay
1 1001984428 2016-04-08 <NA> 4 101 0 0
2 1002360742 2016-04-07 2016-04-07 12 16 1 1
3 1003943907 2016-04-23 <NA> 1 1 0 0
4 100500571 2016-04-06 2016-04-07 10 101 1 0
5 1005541598 2016-04-14 <NA> 1 1 0 0
6 1007334849 2016-04-26 <NA> 2 2 0 0

可见,虽然是一个简单的数据转换问题,但是其中也有很多细节需要留意:数据导入时留意缺失值,日期格式的转换,利用ifelse函数来减少写循环语句,提高代码的高效。

  • 二、如何选择最优模型

对于分类来说,需要把精力花费在学习问题找到合适的分类器。这时候,考虑到不同算法间的各种差异是很有帮助的。例如,在分类问题中,决策树因在建模过程中有明确的规则输出使得模型通俗易懂,而黑箱操作的神经网络得到的模型则很难解释。

我们将在分类实战案例中给大家带来活跃用户流失预测。基本思路如下:导入数据--增加衍生变量--探索数据--利用多个分类算法建立预测模型--选择最优模型。

影响活跃用户流失的普遍判断有:在线活跃、用户账号属性(性别、好友数、等级、积分等)和玩牌情况(玩牌局数、赢牌局数、输牌局数、最高牌型等)。加入我们先从数据库中导出这些含有这些字段的数据集(我们也第一次课也会给大家详解通过RODBC和RMySQL两种方式对MySQL进行管理),然后要增加活跃度和玩牌胜率这两个衍生字段。

接下来,先对数据进行探索,分析用户流失与其他变量之间是否有关系。由于是否流失字段是因子型变量,R自带的cor函数只能对数值型变量求相关系数,故利用caret包中的dummyVars()函数进行哑变量处理后再进行相关性分析,并对相关系数进行可视化展示。

Clipboard Image.png

从上图可以看出,性别对用户是否流失几乎没有什么影响,但是登录总次数和活跃度变量对用户是否流失有强相关性,说明这两个变量是影响玩家流失的主要因素。

我们可以利用随机森林模型中varImpPlot()函数查看每个属性的重要性。

> model <- randomForest(是否流失~.,data=w,importance=TRUE) # 建立随机森林模型
> varImpPlot(model,main="Variable Importance Random Forest") # 查看变量重要性

Clipboard Image.png

MeanDecreaseAccuracy是从精确度来衡量变量重要性,MeanDecreaseGini则是从Gini指数来衡量变量重要性。,变量越重要由上到下排序。可见,玩家的登录总次数、活跃度和积分等变量是决定活跃用户是否流失的重要因素,与通过相关性分析得出的结论一致。

最后我们按照是否流失变量进行等比例随机抽样,将75%的数据作为训练集训练模型,另外的25%数据最为测试集用来验证模型效果。建模代码如下:

> # 利用10折交叉验证来选择最优参数
> control <- trainControl(method="repeatedcv",number=10,repeats=3)
> rpart.model <- train(是否流失~.,data=w,method="rpart",
+ trControl=control)
> rf.model <- train(是否流失~.,data=w,method="rf",
+ trControl=control)
> nnet.model <- train(是否流失~.,data=w,method="nnet",
+ trControl=control)
> # 查看模型结果
> rpart.model
CART

1309 samples
13 predictor
2 classes: '否', '是'

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 3 times)
Summary of sample sizes: 1178, 1178, 1179, 1178, 1179, 1177, ...
Resampling results across tuning parameters:

cp Accuracy Kappa
0.01374570 0.9215751 0.7650789
0.08591065 0.9027083 0.7342419
0.58762887 0.8528716 0.4766954

Accuracy was used to select the optimal model using the largest value.
The final value used for the model was cp = 0.0137457.
> rf.model
Random Forest

1309 samples
13 predictor
2 classes: '否', '是'

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 3 times)
Summary of sample sizes: 1178, 1179, 1179, 1178, 1178, 1177, ...
Resampling results across tuning parameters:

mtry Accuracy Kappa
2 0.9233482 0.7768029
7 0.9190283 0.7652027
13 0.9174976 0.7609324

Accuracy was used to select the optimal model using the largest value.
The final value used for the model was mtry = 2.
> nnet.model
Neural Network

1309 samples
13 predictor
2 classes: '否', '是'

No pre-processing
Resampling: Cross-Validated (10 fold, repeated 3 times)
Summary of sample sizes: 1178, 1178, 1178, 1179, 1178, 1179, ...
Resampling results across tuning parameters:

size decay Accuracy Kappa
1 0e+00 0.8632672 0.5138280
1 1e-04 0.8380369 0.3737944
1 1e-01 0.9136768 0.7402578
3 0e+00 0.9078126 0.7454281
3 1e-04 0.8866204 0.6494807
3 1e-01 0.9067947 0.7275604
5 0e+00 0.9019678 0.7190560
5 1e-04 0.9042404 0.7297342
5 1e-01 0.9078204 0.7342759

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.

我们选择了决策树、随机森林和人工神经网络三种常用的分类算法,通过caret包的train函数进行十折交叉验证,结果给出了三个算法最优的参数值,我们可以将最优的参数值带入模型进行调优,并通过计算各自的NMSE,进而得到最好的预测模型。在本案例中,最后选择了随机森林算法构建的模型来对玩家进行是否流失预测。

  • 三、业务模型大搭建

我们在实际工作中,由于行业特殊性,有很多业务模型是不能常用的模型算法解决的,需要大家根据业务逻辑设计出一套特定的数学模型,然后用计算机能识别的语言编写出来。我们在实战案例中,就会讲到一个常用的渠道用户质量打分模型。这个打分模型跟银行信用评分卡模型很不同,是选择你本行业的特有指标,根据业务规则设计数学模型,然后用R语言编写自定义函数,进而搭建业务模型。渠道用户打分模型主要规则如下:

1)  选取某一周作为起始周,假设全部渠道都处于同一起跑线,默认都是10分。

2) 波动性得分=5*(本周实际值-上周实际值)/最近四周的最大值

3) 量级得分=5*渠道本周值/所有渠道本周总值(只有周收入、周活跃有量级指标,其他三个指标不用考虑量级得分)

4) 各指标得分=上周得分+波动性得分+量级得分

每个渠道起始周均以10分开始计算;以波动性得分来衡量指标的效度,考虑到游戏在不同阶段的用户质量会有所不同,所以我们选用最近四周最大值作为分母,通过(本周实际值-上周实际值)/(最近四周最大值)得到波动性得分;对于周收入和周活跃指标,增加量级得分用来衡量指标的效度,以渠道自身值除以所有渠道总和得到量级得分;最后基础指标本周得分=上周得分+本周波动性得分+量级得分。

我们需要根据以上规则编写自定义函数:

# 自定义channel_score( )实现指标打分模型
# 渠道得分函数
channel_score <- function(data,amount=T){
# 进行指标的波动性打分
library(reshape)
data <- cast(data,渠道名称~自然周)
# 利用apply函数分渠道求出当前周与上周的差值
x <- t(apply(data[,-1],1,diff))
# 利用as.data.frame函将x转换成数据框形式
x <- as.data.frame(x,row.names = as.character(data[,1]))
# 利用colnames函数对x列名重新赋值
colnames(x) <- colnames(data[3:ncol(data)])
# 找出最近四周的最大值
# 自定义函数mystat求最近四周的最大值
mystat <- function(x){
m <- rep(0,(ncol(data)-1))
for(i in 1:(ncol(data)-1)){
if(i <=3){
m[i] <- max(x[1:i])
} else {
m[i] <- max(x[(i-4):i])
}
}
return(m)
}
# 利用apply函按分渠道求最近四周最大值
y <- t(apply(data[,-1],1,mystat))
# 利用as.data.frame函数将y转换成数据框形式
y <- as.data.frame(y,row.names = as.character(data[,1]))
# 利用colnames函数对y列名重新赋值
colnames(y) <- colnames(data[2:ncol(data)])
# 计算波动变化得分
reliability_score <- 5*round(x/y[,-1],3)
reliability_score
if(amount) {
...... #此处省略部分代码
} else {
...... #此处省略部分代码
}
return(score)
}

我们可以利用自定义的channel_score函数对各渠道的核心指标计算得分,最后再根据指标权重得到综合打分。

Clipboard Image.png

由图可知,渠道G从第2周开始,用户得分一直呈现增长趋势,在第10周得分达到13分,属于表现优异的渠道;渠道J和渠道K用户得分整体下滑明显,近期表现中等,需要持续关注或优化。

好了,关于十五大案例的部分内容就先剧透到这,都是以解决实际某个生产问题就做的研究,希望大家学完本课程能对自己的行业数据处理有更深刻的理解,也懂得在哪种阶段运用正确的武器去解决问题,最后祝大家学有所成。

推荐 3
本文由 谢佳标 创作,采用 知识共享署名-相同方式共享 3.0 中国大陆许可协议 进行许可。
转载、引用前需联系作者,并署名作者且注明文章出处。
本站文章版权归原作者及原出处所有 。内容为作者个人观点, 并不代表本站赞同其观点和对其真实性负责。本站是一个个人学习交流的平台,并不用于任何商业目的,如果有任何问题,请及时联系我们,我们将根据著作权人的要求,立即更正或者删除有关内容。本站拥有对此声明的最终解释权。

1 个评论

收下

要回复文章请先登录注册