最近运营部门希望我们帮助他们找出合适的短信营销对象,通过短信营销能够提高他们的投资者再次投资转化率,那么如何找到这个精准人群就是我们部门必须出手做的事情了?但是从几百万投资者中找出最近要复投的用户,这数据挖掘工作究竟该如何入手呢?不着急,我先上结果给大家先看看。

      

基于R语言的数据挖掘实验报告 r语言数据挖掘案例_数据挖掘

(这是我5月9日给出的一波预测会复投的新用户ID,当日下午做营销,5月11日晚20:00的结果)

基于R语言的数据挖掘实验报告 r语言数据挖掘案例_初始化_02

(这是业务部门5月8日做的一波新用户ID营销,5月11日晚20:00的结果)

两者转化率相差5倍!


当然,我们的针对人群是不同的,现在就让我对这次数据挖掘项目做一个回顾吧!


第一步:听懂需求(这一步是数据挖掘项目的最关键步骤,万事开头难,就难在理解需求)

首先我们来听一下业务部门的需求:“这个月新交易用户比其他月份多,我们如何留住这些用户?”或者是“这个月交易压力比较大,我们必须让更多用户做更多次的交易。”

那我们重点讲一下第一个需求:“这个月新交易用户比其他月份多,我们如何留住这些用户?”这个需求的潜在意义是什么?

运用5W1H方法,我们可以得知问题的主要变量:

who:新交易用户

what:留住新交易用户

when:让新用户这个月留住

why:新用户如果本月不交易,那么前面的推广费用就打了水漂

where:让新用户留在本平台上

how:如何(在这个月把尽可能多的新用户留在本平台继续交易)

最终我对这个问题的定义就是,如何找到这个月可能会复投的新用户(上个月新交易用户),对他们进行短信营销促进他们这个月投资?


第二步:用数据解构需求,做好建模分析前的准备

根据问题的主要自变量,我们找出具体的对应数据集:2016年5月至2017年4月每月新交易用户(12个月),每个月的用户数据维度我都从当月取值,保证新交易用户数据不影响目标变量;(在寻找自变量的过程中,还吃了不少亏,不是所有变量都能做模型输入的,需要较长的时间做好数据清洗,比如性别、地域及交易时间等)

那么模型的目标变量该如何确定呢?说一下我在确定目标变量寻找上的误区,供大家参考。

我第一次找的目标变量是本月数据表中上月新用户的第二次交易,后来发现有很多新用户的第二次交易就在上月,目标变量不准确;

第二次我找了本月数据表中上月新用户第二次到第五次交易时间,并且还设定了第二次到第五次交易时间在本月才为目标,但是后来仍然发现,有上月新用户上月就交易超过5次,所以目标变量依然不准确;

第三次我找了本月数据表中上月新用户最近两次交易时间,并且还设定了最近两次交易时间在本月才为目标,至此才把目标变量确定下来。

后面业务部门又提出了新需求,说是是否能找出不给补贴就重复交易的用户,后来我针对这个目标又增加了一个目标变量,无补贴重复交易用户,这是后话。至于如何取该业务需求的目标变量,大家可以探讨一下哈。


第三步:测试建模,调参

把前面的数据都准备好之后,剩下的就是选择模型调试参数,看模型测试结果了,我一般使用xgboost模型做预测,代码分成两部分如下:

1、初始化及调参


library(Matrix) 
 
 library(xgboost)  
 library(Ckmeans.1d.dp)  
 #library(kknn)  
 #library(rminer) 
 

  wk1<-read.csv('d:/Rdata/zjd/lyhft/wkft/164-165.csv',na.string='NA',header=T) 
 
 wk2<-read.csv('d:/Rdata/zjd/lyhft/wkft/165-166.csv',na.string='NA',header=T)  
 wk3<-read.csv('d:/Rdata/zjd/lyhft/wkft/166-167.csv',na.string='NA',header=T)  
 wk4<-read.csv('d:/Rdata/zjd/lyhft/wkft/167-168.csv',na.string='NA',header=T)  
 wk5<-read.csv('d:/Rdata/zjd/lyhft/wkft/168-169.csv',na.string='NA',header=T)  
 wk6<-read.csv('d:/Rdata/zjd/lyhft/wkft/169-1610.csv',na.string='NA',header=T)  
 wk7<-read.csv('d:/Rdata/zjd/lyhft/wkft/1610-1611.csv',na.string='NA',header=T)  
 wk8<-read.csv('d:/Rdata/zjd/lyhft/wkft/1611-1612.csv',na.string='NA',header=T)  
 wk9<-read.csv('d:/Rdata/zjd/lyhft/wkft/1612-171.csv',na.string='NA',header=T)  
 wk10<-read.csv('d:/Rdata/zjd/lyhft/wkft/171-172.csv',na.string='NA',header=T)  
 wk11<-read.csv('d:/Rdata/zjd/lyhft/wkft/172-173.csv',na.string='NA',header=T)  
 wk12<-read.csv('d:/Rdata/zjd/lyhft/wkft/173-174.csv',na.string='NA',header=T)  
 wktest<-read.csv('d:/Rdata/zjd/lyhft/wkft/174.csv',na.string='NA',header=T) 
 

  wkft<-rbind(wk1,wk2,wk3,wk4,wk5,wk6,wk7,wk8,wk9,wk10,wk11,wk12) 
 
 #初始化数据集,设定训练集、预测目标、测试集  
 wkft1<-cbind(wkft[,3:11],wkft[,13:24],wkft[,33])  
 wkft2<-cbind(wkft[,3:11],wkft[,13:24],wkft[,34])  
 #wkft3<-cbind(wkft[,3:11],wkft[,13:24],wkft[,35])  
 #wkft4<-cbind(wkft[,3:11],wkft[,13:24],wkft[,36]) 
 

  wktest1<-cbind(wktest[,3:11],wktest[,13:24]) 

 

  wkft12=Matrix(data.matrix(cbind(wkft1)),sparse=T) 
 
 wkft22=Matrix(data.matrix(cbind(wkft2)),sparse=T)  
 #wkft32=Matrix(data.matrix(cbind(wkft3)),sparse=T)  
 #wkft42=Matrix(data.matrix(cbind(wkft4)),sparse=T) 
 

  wktest2=Matrix(data.matrix(cbind(wktest1)),sparse=T) 

 

  #对训练集和测试集设定可计算的格式 
 
 wktrain1=xgb.DMatrix(data=wkft12[,1:21],label=wkft12[,22])  
 wktrain2=xgb.DMatrix(data=wkft22[,1:21],label=wkft22[,22])  
 #wktrain3=xgb.DMatrix(data=wkft32[,1:21],label=wkft12[,22])  
 #wktrain4=xgb.DMatrix(data=wkft42[,1:21],label=wkft22[,22]) 
 

  dtest=xgb.DMatrix(data=wktest2[,1:21]) 

 

  #subsam=c(0.5,0.7,0.9) 
 
 #colsam=c(0.5,0.7,0.9)  
 weight=c(1,3,5)  
 depth=c(10,12,15)  
 eta=c(0.4,0.5,0.6)  
 b1<-matrix(0,1,7)  
 for (i in 1:length(weight)){  
   for (m in 1:length(depth)){  
     for (n in 1:length(eta)){  
       #测试模型并调整参数  
       model=xgb.cv(booster='gbtree',  
              objective='binary:logistic',  
              scale_pos_weight=6.8125,  
              gamma=0.1,  
              lambda=1210,  
              subsample=0.7,  
              set.seed=10000,  
              colsample_bytree=0.5,  
              min_child_weight=weight[i],  
              max_depth=depth[m],  
              eta=eta[n],  
              data=wktrain1,  
              nrounds=1000,  
              metrics='error',  
              nfold=10,  
              verbose=1,  
              showsd=1,  
              print.every.n=100,  
              #nthread=100  
              )  
       b=cbind(weight[i],depth[m],eta[n],which.min(model$train.error.mean),min(model$train.error.mean),which.min(model$test.error.mean),min(model$test.error.mean))  
       b1=rbind(b1,b)  
       }}} 
 

  b2<-matrix(0,1,7) 
 
 for (i in 1:length(weight)){  
   for (m in 1:length(depth)){  
     for (n in 1:length(eta)){  
       model=xgb.cv(booster='gbtree',  
              objective='binary:logistic',  
              scale_pos_weight=6.8125,  
              gamma=0.1,  
              lambda=1210,  
              subsample=0.7,  
              set.seed=10000,  
              colsample_bytree=0.5,  
              min_child_weight=weight[i],  
              max_depth=depth[m],  
              eta=eta[n],  
              data=wktrain2,  
              nrounds=1000,  
              metrics='error',  
              nfold=10,  
              verbose=1,  
              showsd=1,  
              print.every.n=100,  
              #nthread=100  
       )  
       b=cbind(weight[i],depth[m],eta[n],which.min(model$train.error.mean),min(model$train.error.mean),which.min(model$test.error.mean),min(model$test.error.mean))  
       b2=rbind(b2,b)  
     }}}  
 b1<-b1[-1,]  
 b2<-b2[-1,]  
 write.csv(b1,file = "d:/Rdata/zjd/lyhft/wkft/wkcs1.csv")  
 write.csv(b2,file = "d:/Rdata/zjd/lyhft/wkft/wkcs2.csv")

2、根据最优测试方案设定参数跑出模型

#根据测试模型设定正式参数并跑出模型
 model.x1<-xgb.train(
   booster='gbtree',
   objective='binary:logistic',
   scale_pos_weight=6.8125,
   gamma=0.1,
   lambda=1210,
   subsample=0.7,
   set.seed=5000,
   colsample_bytree=0.3,
   min_child_weight=5,
   max_depth=15,
   eta=0.3,
   data=wktrain1,
   nrounds=5000,
   metrics='error',
   nfold=10
   #verbose=1,
   #showsd=1,
   #print.every.n=1,
   #nthread=100
 )
 model.x2<-xgb.train(
   booster='gbtree',
   objective='binary:logistic',
   scale_pos_weight=6.8125,
   gamma=0.1,
   lambda=1210,
   subsample=0.7,
   set.seed=5000,
   colsample_bytree=0.3,
   min_child_weight=5,
   max_depth=15,
   eta=0.3,
   data=wktrain2,
   nrounds=5000,
   metrics='error',
   nfold=10
   #verbose=1,
   #showsd=1,
   #print.every.n=1,
   #nthread=100


)

3、预测复投人群并画出各维度权重

#预测测试集目标变量 
 
 pred1<-predict(model.x1,dtest)  
 pred2<-predict(model.x2,dtest)  
 #pred3<-predict(model.x3,dtest)  
 #pred4<-predict(model.x4,dtest)  
 #存储模型  
 xgb.save(model.x1,'d:/Rdata/zjd/lyhft/wkft/2017041')  
 xgb.save(model.x2,'d:/Rdata/zjd/lyhft/wkft/2017042')  
 #xgb.save(model.x3,'d:/Rdata/zjd/lyhft/wkft/2017043')  
 #xgb.save(model.x4,'d:/Rdata/zjd/lyhft/wkft/2017044')  
 #xg5<-xgb.load('d:/Rdata/zjd/lyhft/wkft/201704')  
 #导出测试数据及测试结果  
 a<-cbind(wktest,pred1,pred2)  
 write.csv(a,file = "d:/Rdata/zjd/lyhft/wkft/wkftxg.csv") 
 

  # 计算特征重要性矩阵 
 
 model <- xgb.dump(model.x1, with.stats = T)  
 names<-dimnames(wkft12[,-22])[[2]]  
 importance_jf <- xgb.importance(names, model = model.x1)  
 xgb.plot.importance(importance_jf)



各维度最终权重结果如下图:



基于R语言的数据挖掘实验报告 r语言数据挖掘案例_xgboost_03



最终结果大家也可以看到,我复投预测的数据经过同样的活动及短信营销后,转化率为10%,7天后最终转化率超过了20%;


而业务部门做的5月8日的同样活动,也是发送的是新用户人群,转化率为2.5%,7天后最终转化率没有超过5%。