用R做一个完整的数据挖掘项目

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

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

(这是业务部门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)

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

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

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