看书笔记——R语言
【R语言数据分析项目精解：理论、方法、实战 8】
Chapter 8 从数据中寻找优质用户
8.1项目背景、目标和方案
8.1.1项目背景
由于活动规模有限，对邀请用户的数量有一定的限制，市场部希望邀请到一些高质量的有潜在购买力的用户，希望在用户画像系统中加入一个能够反映用户是否具有潜在购买力的标签。
8.1.2项目目标
在用户画像的标签制作上加一个标签衡量“潜在购买力”，该标签的目标是一个离散型且分值在10以内的等距量化指标，利用统计模型将用户信息映射到一个离散化的数值范围。
8.1.3项目方案
用近6个月的用户的基本信息和历史行为记录作为训练集建立逻辑回归模型对进行拟合建模，对近一个月内下单的用户购买可能性打标签，市场人员可以就这个指标值挑选。
8.2项目技术理论简介
主要是关于逻辑回归模型的知识。
8.2.1逻辑回归的基本概念
1.引理
对于分类变量，逻辑回归曲线到线性曲线的距离会小于每个点到线性回归的距离。
2.逻辑回归模型
l
o
g
i
t
(
p
)
=
l
n
(
p
1
−
p
)
=
β
0
+
β
1
x
1
+
.
.
.
+
β
n
x
n
,
x
1
,
.
.
.
,
x
n
logit(p)=ln(\frac{p}{1-p})=\beta_0+\beta_1x_1+...+\beta_nx_n,x_1,...,x_n
logit(p)=ln(1−pp)=β0+β1x1+...+βnxn,x1,...,xn为n个变量
3.Odds（优势）
O
d
d
s
=
p
1
−
p
Odds=\frac{p}{1-p}
Odds=1−pp，表示的是事件发生的概率与事件不发生的概率之比。
4.logit变换
l
o
g
i
t
(
p
)
=
l
n
(
o
d
d
s
)
=
l
n
(
p
1
−
p
)
logit(p)=ln(odds)=ln(\frac{p}{1-p})
logit(p)=ln(odds)=ln(1−pp)
可知
l
n
(
p
1
−
p
)
=
η
,
p
=
1
1
+
e
−
η
ln(\frac{p}{1-p})=\eta,p=\frac{1}{1+e^{-\eta}}
ln(1−pp)=η,p=1+e−η1
式中，
η
=
β
0
+
β
1
x
1
+
.
.
.
+
β
n
x
n
\eta=\beta_0+\beta_1x_1+...+\beta_nx_n
η=β0+β1x1+...+βnxn
得
y
=
p
+
ε
,
ε
∼
B
(
n
,
p
)
,
V
a
r
(
ε
)
=
p
(
1
−
p
)
y=p+\varepsilon,\varepsilon \sim B(n,p),Var(\varepsilon)=p(1-p)
y=p+ε,ε∼B(n,p),Var(ε)=p(1−p)
所以
y
∼
B
(
n
,
p
)
y\sim B(n,p)
y∼B(n,p)
5.极大似然估计
想得到闭合形式解，就必须使用极大似然估计，似然函数公式：
6.离散变量处理
逻辑回归的自变量都要是连续型变量，“哑变量”可以将离散型变量转变为连续型变量，生成的哑变量个数为水平数-1（这样可以减少变量间的共线性）。
7.优势比 Odds Rations
O
R
=
P
1
/
(
1
−
P
1
)
P
2
/
(
1
−
P
2
)
OR=\frac{P_1/(1-P_1)}{P_2/(1-P_2)}
OR=P2/(1−P2)P1/(1−P1)
（1）离散变量
l
o
g
i
t
(
p
)
=
l
n
p
1
−
p
=
β
0
+
β
1
D
logit(p)=ln\frac{p}{1-p}=\beta_0+\beta_1D
logit(p)=ln1−pp=β0+β1D
D=0代表男性，D=1代表女性，所以女性的Odds为
e
β
0
+
β
1
e^{\beta_0+\beta_1}
eβ0+β1，男性的Odds为
e
β
0
e^{\beta_0}
eβ0.
O
R
(
女性
V
S
男性
)
=
e
β
0
+
β
1
e
β
0
=
e
β
1
OR(女性VS男性)=\frac{e^{\beta_0+\beta_1}}{e^{\beta_0}}=e^{\beta_1}
OR(女性VS男性)=eβ0eβ0+β1=eβ1
（2）连续型变量
l
o
g
i
t
(
p
)
=
l
n
p
1
−
p
=
β
0
+
β
1
x
1
logit(p)=ln\frac{p}{1-p}=\beta_0+\beta_1x_1
logit(p)=ln1−pp=β0+β1x1
O
R
(
x
1
)
=
e
β
0
+
β
1
(
x
+
1
)
e
β
0
+
β
1
x
=
e
β
1
OR(x_1)=\frac{e^{\beta_0+\beta_1(x+1)}}{e^{\beta_0+\beta_1x}}=e^{\beta_1}
OR(x1)=eβ0+β1xeβ0+β1(x+1)=eβ1
8.2.2建模流程
1.模型开发
数据采样：需要得到训练样本、验证集、测试集，主要与需求方商讨后提供材料。
数据探索：描述性统计分析，对数据的基本特征进行了解。
数据填缺：单一填补、多重填补等，缺失值比例大小对今后模型的稳定性影响较大。
变量压缩：多个变量具有共线性，需要进行变量压缩。
变量筛选：剔除预测力不够的变量，否则会影响模型的稳定性，减少复杂度同时提高稳定性。
变量调整：x和logit§应该近似线性，否则还需对数据进行变换。
模型开发：建立逻辑回归模型，进行参数估计。
2.模型验证阶段
用测试集对模型的参数进行调优。
数据处理：与测试集的数据保持一致
误分类矩阵：训练集得到的模型用到验证集的预测比情况
ROC图：训练集得到的模型用到验证集的预测，得到的ROC图或LIFT图
模型比较：根据ROC图、AUC图、误分矩阵、精准率和召回率等比较模型的预测性能
模型确认：综合全部指标的比较得到结果
3.模型测试阶段
参数3调优后，仍然会有备选模型（影子模型）
数据处理》收益矩阵》模型打分》决策》决策》价值判断
4.模型实施阶段
模型上线》周期评估》模型检测》新模型开发
8.2.3模型开发阶段
1.数据采样
跟业务和需求方充分沟通，得到更靠谱、更贴近实际的数据类。
(1）已知总体，但是总体中响应样本的数据过少。这时候通过数据采样，保留所有响应样本，使得响应样本在采样后的数据集中占有一定的比例，这样有利于后续建模。一般响应样本与非响应样本之比为1∶4较好。
(2）总体未知，但是根据历史经验，知道响应的先验概率，此时获得的数据就是采样数据而不是总体数据，故在使用采样数据建模的过程中需要对采样数据的概率做调整。在最终的模型预测值上需要根据原先的比例对预测概率做调整，降低预测概率以符合实际情况。一般情况下，可以用下面的公式进行调整:
2.数据探索
（1）连续型：均值、方差、偏度、峰度、正态性、分位数点、相关性和缺失值比例。
（2）离散型：频度分析、缺失值比例。若水平相应概率为零，则需要合并响应概率接近的组，尽可能消除为零的水平。
3.数据填缺
缺失达到80%的可以剔除，其他的可以填充：
（1）均值替换：连续型用均值填充，离散型用众数填充。完全随机缺失的假设
（2）热卡填充：用相关系数找到相似对象
（3）回归替换：建立回归方程，用缺失值期望替换缺失值
（4）多重插补：产生缺失值的一个随机样本，对统计结果进行综合
4.离散型变量压缩
哑变量、WOE（weight of evidence，证据权重，可以通过WOE变化使ROC达到最优，且极大化因变量的辨识度）、聚类分析
5.连续型变量压缩
见chapter6
6.变量筛选（用到的时候再细看一下，主要是权重那一套）
剔除与因变量关系较弱的变量，精简模型
（1）spearman等级相关系数是一种非参数统计相关方法，pearson相关系数必须假设数据成对地从正态分布取得且数据在逻辑范围内是等距的。spearman只需要两个变量是单调的，而pearson需要两个变量是线性关系。
（2）IV（Information Value,信息量）
以WOE为基础并且在逻辑回归中的重要指标IV，衡量一个指标对因变量的重要程度，值越高，预测能力越强，为变量筛选提供了理论依据。
7.变量调整——logit图
观察各变量的logit图折线图需要为近似直线，即可加入模型，若不为线性，则需要对原始变量进行编码或转换（Bin编码、取对数、开根号等），直到折线图为直线。
8.线性假设
让步比（Odds Ratio）应该恒定不变，若不恒定，还需对变量进行变换。
9.模型开发
开发的方法有：全模型、向前法、向后法、向前向后逐步法
8.2.4模型验证阶段
1.验证集数据处理：缺失值的填补，均值、中位数等
2.评价模型标准：混淆矩阵、ROC曲线、Lift和Gain图Gain图
8.2.5模型测试阶段
1.模型打分
适用于在原始数据集中响应概率偏低或者总体未知的情形，见8.2.3.
2.确定阈值（cutoff）
阈值的主要作用是预测概率达到多大时判断其为响应，常用收益矩阵确定阈值。
3.计算总收益
计算一下模型的收益大概是多少，便于后期模型评估的分析。
4.判断是否有必要建模
主要考虑开发成本和模型效能的评估
8.2.6商业应用流程
8.2.7R语言实例代码
1.生成哑变量
#生成测试数据
a1<-c("a",'b','a','e','e','b','a')
b1<-c(1,2,3,4,5,6,7)
df<-data.frame(a1,b1)
#生成哑变量
dummyvar<-model.matrix(~df$a1)[,-1]
#加到原始数据中
df_adj<-cbind(df,dummyvar)
df_adj
三个水平数对应两个哑变量
2.计算WOE和IV
#####################################################################
#函数功能：计算变量woe和iv值
#参数说明： df：数据框（需要建模的训练数据）、flag_loc：因变量所在位置、var_loc：需要转变为woe和计算iv的变量所在位置
woe_fun<-function(df,flag_loc,var_loc){
n_1t<-table(df[,flag_loc])[2]
n_0t<-table(df[,flag_loc])[1]
varname<-names(df)[var_loc]
fact_n<-as.vector(unique(df[,var_loc]))
fact<-c()
woe<-c()
iv<-c()
for (i in fact_n){
subsetdf<-paste("subset(df,",varname,"=='",i,"')",sep="")
df_i<-eval(parse(text=subsetdf))
n_1i<-table(df_i[,flag_loc])[2]
n_0i<-table(df_i[,flag_loc])[1]
p_1i<-n_1i/n_1t
p_0i<-n_0i/n_0t
woe_i<-log(p_1i/p_0i)
iv_i<-(p_1i-p_0i)*woe_i
fact<-c(fact,i)
woe<-c(woe,woe_i)
iv<-c(iv,iv_i)
}
woeres<-paste("woeres<-data.frame(",varname,"=fact,woe_",varname,"=woe)",sep='')
eval(parse(text=woeres))
ivres<-sum(iv)
return(list(woe=woeres,iv=ivres))
}
setwd("C:\\Users\\用户路径")
testdf<-read.csv("data_chap9.csv",header=TRUE,stringsAsFactors=FALSE)
woe_fun(testdf,2,which(names(testdf)=="v18"))
自定义函数的list对象为离散变量每个水平下的WOE值、IV值
3.计算spearman相关系数
#####################################################################
#函数功能：计算变量与因变量的相关系数
#参数说明：df：数据框（需要建模的训练数据）\flag_loc：因变量所在位置、method：计算相关系数的方法，默认为spearman相关系数
spearman_var<-function(df,flag_loc,method='spearman'){
depend_var<-df[flag_loc]
varname<-names(df[-flag_loc])
spearman_cor<-c()
for (i in varname){
vari<-as.numeric(as.vector(df[,i]))
spearman_i<-cor(depend_var,vari,method=method)
spearman_cor<-c(spearman_cor,spearman_i)
}
spearmandf<-data.frame(varname=varname,spearman=spearman_cor)
return(spearmandf)
}
spearman_var(testdf[,-c(1,20)],1)
输出的是所有变量与因变量的spearman相关系数
4.计算各变量的IV值
#选择计算iv的变量位置（一定要是离散型变量，维度不能过多）
var_loc<-c(3,4,6) ##选离散型变量
varnames<-names(testdf)[var_loc]
iv<-c()
#计算各个变量的iv值
for (i in var_loc) {
ivi<-woe_fun(testdf,2,i)$iv ##整合用woe函数计算每个离散型变量的IV值，并给出判断结果
iv<-c(iv,ivi)
}
#根据iv判断变量有无预测力
var_iv<-data.frame(varname=varnames,iv=iv)
var_iv$iv_desc<-c("无")
attach(var_iv)
var_iv[which(iv<0.02),]$iv_desc<-"无预测力"
var_iv[which(iv>=0.02 & iv<0.1),]$iv_desc<-"预测力弱"
var_iv[which(iv>=0.1 & iv<0.3),]$iv_desc<-"预测力中"
var_iv[which(iv>=0.3),]$iv_desc<-"预测力强"
detach(var_iv)
var_iv
5.logit图
#####################################################################
#函数功能：计算连续性变量的logit值以及画出logit图
#参数说明：df：数据框（需要建模的训练数据）、flag_loc：因变量所在位置、var_loc：连续型自变量所在的位置、groups：分成的组类别数
logitfun<-function(df,flag_loc,var_loc,groups=100){
opar<-par(no.readonly=TRUE)
par(mfrow=c(2,1))
df_logit<-df[,c(flag_loc,var_loc)]
names(df_logit)<-c("flag","var")
group<-floor(rank(df_logit$var)*groups/(length(df_logit$var)+1))
df_logit$group<-group
ntot<-as.data.frame(table(df_logit$group))
names(ntot)<-c("group","ntot")
ntot$group<-as.numeric(as.vector(ntot$group))
npos<-as.data.frame(table(subset(df_logit,flag==1)$group))
names(npos)<-c("group","npos")
npos$group<-as.numeric(as.vector(npos$group))
varlogit<-join(ntot,npos)
varlogit$logit<-log((varlogit$npos+sqrt(varlogit$ntot)/2)
/(varlogit$ntot-varlogit$npos+sqrt(varlogit$ntot)/2))
varavg<-aggregate(df_logit,by=list(group),FUN=mean)[,c("Group.1","var")]
names(varavg)[1]<-'group'
logit_res<-join(varavg,varlogit,by="group")
logit_res$bin<-c(1:nrow(logit_res))
plot(logit_res$var,logit_res$logit,type='o',main="均值-logit")
plot(logit_res$bin,logit_res$logit,type='o',main="bin-logit")
par(opar)
return(logit_res)
}
logitfun(testdf,2,5)
自定义函数输出logit值、对应的组均值及bin值及均值-logit图和bin-logit图，bin-logit改善了均值-logit的线性情况。
8.3项目实践
10000个样本，18个自变量，flag这一个因变量
8.3.1数据探索
1.因变量分布
#---------取数
setwd("C:\\Users\\用户路径")
testdf<-read.csv("data_chap9.csv",header=TRUE,stringsAsFactors=FALSE)
testdf$rnd<-runif(10000,0,1)
#--------分训练集和测试集
train_set<-subset(testdf,rnd<=0.6)[,-21]
test_set<-subset(testdf,rnd>0.6)[,-21]
table(testdf$flag)
table(train_set$flag)
table(test_set$flag)
响应变量约为30%，顾不需要调整结果的概率值。60%训练集，40%测试集，对应的响应也近似30%。
2.自变量探索
table(train_set$v6) ##3水平
table(train_set$v18) ##10个水平，其余为2水平
summary(train_set$v3)
summary(train_set$v11)
summary(train_set$v12)
summary(train_set$v13) ##连续型变量，无缺失值，且范围跨度有大有小。
#### 8.3.2数据处理
1.生成哑变量（模型开发）
```r
train_set$v6<-as.factor(train_set$v6)
dummyvar<-model.matrix(~train_set$v6)[,-1]
train_set<-cbind(train_set,dummyvar) #将变量生成n-1个哑变量加到原始数据中
train_set<-train_set[,-(which(names(train_set)=="v6"))] ##删除原始离散变量
names(train_set)[20]<-"v6_1"
names(train_set)[21]<-"v6_2"
#查看前几行数据
head(train_set)
2.计算WOE
##合并五个类别，用VAC代替
train_set[which(train_set$v18=='CRP'),]$v18<-'VAC'
train_set[which(train_set$v18=='VIS'),]$v18<-'VAC'
train_set[which(train_set$v18=='DIY'),]$v18<-'VAC'
train_set[which(train_set$v18=='PKG'),]$v18<-'VAC'
train_set[which(train_set$v18=='TRM'),]$v18<-'VAC'
woe_train<-woe_fun(train_set,2,which(names(train_set)=="v18"))[[1]] ##自定义函数计算WOE替换变量
woe_train$v18<-as.character(as.vector(woe_train$v18)) #将变量类型转换成与原始变量一致（根据具体情况删减）
train_set<-join(train_set,woe_train) #将原始变量用WOE值替换
train_set<-train_set[,-which(names(train_set)=='v18')]
head(train_set)
3.计算spearman等级相关系数
spearman_var(train_set[,-1],1) #去除第一行（id为行号，无特殊意义）2\3\5\8\10对变量相关性较高
4.计算各离散型变量的IV值
#选择计算iv的变量位置（一定要是离散型变量，维度不能过多）
var_loc<-c(3,4,6:11,15:20)
varnames<-names(train_set)[var_loc]
iv<-c()
#计算各个变量的iv值
for (i in var_loc) {
ivi<-woe_fun(train_set,2,i)$iv ##woe_fun函数求IV 值
iv<-c(iv,ivi)
print(paste(i,"is finished!",sep=''))
}
#根据iv判断变量有无预测力
var_iv<-data.frame(varname=varnames,iv=iv)
var_iv$iv_desc<-c("无")
attach(var_iv)
var_iv[which(iv<0.02),]$iv_desc<-"无预测力"
var_iv[which(iv>=0.02 & iv<0.1),]$iv_desc<-"预测力弱"
var_iv[which(iv>=0.1 & iv<0.3),]$iv_desc<-"预测力中"
var_iv[which(iv>=0.3),]$iv_desc<-"预测力强"
detach(var_iv)
var_iv
#####5、8、10、15的预测能力较好
5.连续型变量logit图
v3和v13两个变量的logit图未呈线性，需要进行Bin变换，其连续变量不用处理。
#v3、v13连续型变量logit图
var_loc<-which(names(train_set)=="v3")
logitfun(train_set,2,var_loc,groups=100)
#用bin去替代
groups<-100
df_logit<-train_set[,c(1,var_loc)]
group<-floor(rank(df_logit[,2])*groups/(length(df_logit[,2])+1))
df_logit$group<-group
df_logit<-df_logit[,-2]
train_set<-join(train_set,df_logit)
names(train_set)[which(names(train_set)=="group")]<-"v3_bin"
train_set<-train_set[,-var_loc]
var_loc<-which(names(train_set)=="v13")
logitfun(train_set,2,var_loc,groups=100)
#用bin去替代
groups<-100
df_logit<-train_set[,c(1,var_loc)]
group<-floor(rank(df_logit[,2])*groups/(length(df_logit[,2])+1))
df_logit$group<-group
df_logit<-df_logit[,-2]
train_set<-join(train_set,df_logit)
names(train_set)[which(names(train_set)=="group")]<-"v13_bin"
train_set<-train_set[,-var_loc]
head(train_set)
8.3.3建立模型
#设定自变量、因变量和数据集 训练集上建模
vars<-"v1+v2+v4+v5+v7+v8+v9+v10+v11+v12+v14+v15+v16+v17+v6_1+v6_2+woe_v18+v3_bin+v13_bin"
trainset<-"train_set"
depend_var<-"flag"
glm_fit_fuc<-paste("glm_fit=glm(",depend_var,"~",vars,",data=",trainset,",family=binomial(link='logit'))"
,sep="")
eval(parse(text=glm_fit_fuc))
summary(glm_fit)
glm_step<-step(glm_fit)
summary(glm_step)
#最终模型
#模型1：
vars<-"v1+v2+v4+v5+v7+v8+v10+v11+v14+v15+v17+v6_2+v3_bin+v13_bin"
trainset<-"train_set"
depend_var<-"flag"
glm_fit_fuc<-paste("glm_fit=glm(",depend_var,"~",vars,",data=",trainset,",family=binomial(link='logit'))"
,sep="")
eval(parse(text=glm_fit_fuc))
summary(glm_fit)
全部变量放入模型，后用step函数进行调优，选择显著的系数
8.3.4模型验证
模型在测试集上建立后，需要在测试集上验证，验证集的处理需要和测试集的处理一致
1、数据调整和变换
test_set<-subset(testdf,rnd>0.6)[,-21]
#---------生成哑变量
test_set$v6<-as.factor(test_set$v6)
dummyvar<-model.matrix(~test_set$v6)[,-1]
test_set<-cbind(test_set,dummyvar) #加到原始数据中
test_set<-test_set[,-(which(names(test_set)=="v6"))]
names(test_set)[20]<-"v6_1"
names(test_set)[21]<-"v6_2"
#----------将v18中的trm和vis合并 生成WOE
test_set[which(test_set$v18=='CRP'),]$v18<-'VAC'
test_set[which(test_set$v18=='VIS'),]$v18<-'VAC'
test_set[which(test_set$v18=='DIY'),]$v18<-'VAC'
test_set[which(test_set$v18=='PKG'),]$v18<-'VAC'
test_set[which(test_set$v18=='TRM'),]$v18<-'VAC'
#将原始变量用训练集上WOE值替换
test_set<-join(test_set,woe_train)
test_set<-test_set[,-which(names(test_set)=='v18')]
#-------------------------#
##实现了测试集的哑变量和WOE变换，对v3和v13的分组都要按照训练集上的区间进行
#-------------------------#
#----------连续型变量调整--------------
#对v3和v13进行bin调整
test_set$v3_bin<-c(rep(0,nrow(test_set)))
attach(test_set)
test_set[which(v3<=440),]$v3_bin<-0
test_set[which(v3>440 & v3<=463),]$v3_bin<-1
test_set[which(v3>463 & v3<=479),]$v3_bin<-2
test_set[which(v3>479 & v3<=492),]$v3_bin<-3
test_set[which(v3>492 & v3<=502),]$v3_bin<-4
test_set[which(v3>502 & v3<=513),]$v3_bin<-5
test_set[which(v3>513 & v3<=528),]$v3_bin<-6
test_set[which(v3>528 & v3<=540),]$v3_bin<-7
test_set[which(v3>540 & v3<=550),]$v3_bin<-8
test_set[which(v3>550 & v3<=560),]$v3_bin<-9
test_set[which(v3>560 & v3<=571),]$v3_bin<-10
test_set[which(v3>571 & v3<=583),]$v3_bin<-11
test_set[which(v3>583 & v3<=595),]$v3_bin<-12
test_set[which(v3>595 & v3<=602),]$v3_bin<-13
test_set[which(v3>602 & v3<=610),]$v3_bin<-14
test_set[which(v3>610 & v3<=617),]$v3_bin<-15
test_set[which(v3>617 & v3<=624),]$v3_bin<-16
test_set[which(v3>624 & v3<=631),]$v3_bin<-17
test_set[which(v3>631 & v3<=638),]$v3_bin<-18
test_set[which(v3>638 & v3<=646),]$v3_bin<-19
test_set[which(v3>646 & v3<=653),]$v3_bin<-20
test_set[which(v3>653 & v3<=661),]$v3_bin<-21
test_set[which(v3>661 & v3<=668),]$v3_bin<-22
test_set[which(v3>668 & v3<=674),]$v3_bin<-23
test_set[which(v3>674 & v3<=680),]$v3_bin<-24
test_set[which(v3>680 & v3<=689),]$v3_bin<-25
test_set[which(v3>689 & v3<=697),]$v3_bin<-26
test_set[which(v3>697 & v3<=705),]$v3_bin<-27
test_set[which(v3>705 & v3<=712),]$v3_bin<-28
test_set[which(v3>712 & v3<=717),]$v3_bin<-29
test_set[which(v3>717 & v3<=724),]$v3_bin<-30
test_set[which(v3>724 & v3<=732),]$v3_bin<-31
test_set[which(v3>732 & v3<=749),]$v3_bin<-32
test_set[which(v3>749 & v3<=770),]$v3_bin<-33
test_set[which(v3>770 & v3<=798),]$v3_bin<-34
test_set[which(v3>798 & v3<=828),]$v3_bin<-35
test_set[which(v3>828 & v3<=841),]$v3_bin<-36
test_set[which(v3>841 & v3<=852),]$v3_bin<-37
test_set[which(v3>852 & v3<=867),]$v3_bin<-38
test_set[which(v3>867 & v3<=881),]$v3_bin<-39
test_set[which(v3>881 & v3<=900),]$v3_bin<-40
test_set[which(v3>900 & v3<=919),]$v3_bin<-41
test_set[which(v3>919 & v3<=939),]$v3_bin<-42
test_set[which(v3>939 & v3<=953),]$v3_bin<-43
test_set[which(v3>953 & v3<=973),]$v3_bin<-44
test_set[which(v3>973 & v3<=996),]$v3_bin<-45
test_set[which(v3>996 & v3<=1020),]$v3_bin<-46
test_set[which(v3>1020 & v3<=1066),]$v3_bin<-47
test_set[which(v3>1066 & v3<=1107),]$v3_bin<-48
test_set[which(v3>1107 & v3<=1140),]$v3_bin<-49
test_set[which(v3>1140 & v3<=1182),]$v3_bin<-50
test_set[which(v3>1182 & v3<=1213),]$v3_bin<-51
test_set[which(v3>1213 & v3<=1240),]$v3_bin<-52
test_set[which(v3>1240 & v3<=1276),]$v3_bin<-53
test_set[which(v3>1276 & v3<=1314),]$v3_bin<-54
test_set[which(v3>1314 & v3<=1353),]$v3_bin<-55
test_set[which(v3>1353 & v3<=1389),]$v3_bin<-56
test_set[which(v3>1389 & v3<=1427),]$v3_bin<-57
test_set[which(v3>1427 & v3<=1468),]$v3_bin<-58
test_set[which(v3>1468 & v3<=1501),]$v3_bin<-59
test_set[which(v3>1501 & v3<=1549),]$v3_bin<-60
test_set[which(v3>1549 & v3<=1598),]$v3_bin<-61
test_set[which(v3>1598 & v3<=1635),]$v3_bin<-62
test_set[which(v3>1635 & v3<=1678),]$v3_bin<-63
test_set[which(v3>1678 & v3<=1712),]$v3_bin<-64
test_set[which(v3>1712 & v3<=1763),]$v3_bin<-65
test_set[which(v3>1763 & v3<=1806),]$v3_bin<-66
test_set[which(v3>1806 & v3<=1843),]$v3_bin<-67
test_set[which(v3>1843 & v3<=1887),]$v3_bin<-68
test_set[which(v3>1887 & v3<=1927),]$v3_bin<-69
test_set[which(v3>1927 & v3<=1958),]$v3_bin<-70
test_set[which(v3>1958 & v3<=1993),]$v3_bin<-71
test_set[which(v3>1993 & v3<=2025),]$v3_bin<-72
test_set[which(v3>2025 & v3<=2055),]$v3_bin<-73
test_set[which(v3>2055 & v3<=2078),]$v3_bin<-74
test_set[which(v3>2078 & v3<=2119),]$v3_bin<-75
test_set[which(v3>2119 & v3<=2156),]$v3_bin<-76
test_set[which(v3>2156 & v3<=2183),]$v3_bin<-77
test_set[which(v3>2183 & v3<=2216),]$v3_bin<-78
test_set[which(v3>2216 & v3<=2265),]$v3_bin<-79
test_set[which(v3>2265 & v3<=2316),]$v3_bin<-80
test_set[which(v3>2316 & v3<=2358),]$v3_bin<-81
test_set[which(v3>2358 & v3<=2399),]$v3_bin<-82
test_set[which(v3>2399 & v3<=2452),]$v3_bin<-83
test_set[which(v3>2452 & v3<=2503),]$v3_bin<-84
test_set[which(v3>2503 & v3<=2550),]$v3_bin<-85
test_set[which(v3>2550 & v3<=2600),]$v3_bin<-86
test_set[which(v3>2600 & v3<=2675),]$v3_bin<-87
test_set[which(v3>2675 & v3<=2736),]$v3_bin<-88
test_set[which(v3>2736 & v3<=2806),]$v3_bin<-89
test_set[which(v3>2806 & v3<=2869),]$v3_bin<-90
test_set[which(v3>2869 & v3<=2966),]$v3_bin<-91
test_set[which(v3>2966 & v3<=3071),]$v3_bin<-92
test_set[which(v3>3071 & v3<=3177),]$v3_bin<-93
test_set[which(v3>3177 & v3<=3292),]$v3_bin<-94
test_set[which(v3>3292 & v3<=3431),]$v3_bin<-95
test_set[which(v3>3431 & v3<=3594),]$v3_bin<-96
test_set[which(v3>3594 & v3<=3774),]$v3_bin<-97
test_set[which(v3>3774 & v3<=4571),]$v3_bin<-98
test_set[which(v3>4571),]$v3_bin<-99
detach(test_set)
test_set$v13_bin<-c(rep(0,nrow(test_set)))
attach(test_set)
test_set[which(v13<=1022.5),]$v13_bin<-0
test_set[which(v13>779 & v13<=1022.5),]$v13_bin<-1
test_set[which(v13>1022.5 & v13<=1209),]$v13_bin<-2
test_set[which(v13>1209 & v13<=1374.5),]$v13_bin<-3
test_set[which(v13>1374.5 & v13<=1544),]$v13_bin<-4
test_set[which(v13>1544 & v13<=1662),]$v13_bin<-5
test_set[which(v13>1662 & v13<=1833),]$v13_bin<-6
test_set[which(v13>1833 & v13<=1988.5),]$v13_bin<-7
test_set[which(v13>1988.5 & v13<=2147),]$v13_bin<-8
test_set[which(v13>2147 & v13<=2296),]$v13_bin<-9
test_set[which(v13>2296 & v13<=2477),]$v13_bin<-10
test_set[which(v13>2477 & v13<=2640),]$v13_bin<-11
test_set[which(v13>2640 & v13<=2778),]$v13_bin<-12
test_set[which(v13>2778 & v13<=2900),]$v13_bin<-13
test_set[which(v13>2900 & v13<=3043),]$v13_bin<-14
test_set[which(v13>3043 & v13<=3200),]$v13_bin<-15
test_set[which(v13>3200 & v13<=3345),]$v13_bin<-16
test_set[which(v13>3345 & v13<=3457),]$v13_bin<-17
test_set[which(v13>3457 & v13<=3640),]$v13_bin<-18
test_set[which(v13>3640 & v13<=3775),]$v13_bin<-19
test_set[which(v13>3775 & v13<=3920),]$v13_bin<-20
test_set[which(v13>3920 & v13<=4051),]$v13_bin<-21
test_set[which(v13>4051 & v13<=4150),]$v13_bin<-22
test_set[which(v13>4150 & v13<=4287),]$v13_bin<-23
test_set[which(v13>4287 & v13<=4438),]$v13_bin<-24
test_set[which(v13>4438 & v13<=4584),]$v13_bin<-25
test_set[which(v13>4584 & v13<=4720),]$v13_bin<-26
test_set[which(v13>4720 & v13<=4831),]$v13_bin<-27
test_set[which(v13>4831 & v13<=5005),]$v13_bin<-28
test_set[which(v13>5005 & v13<=5132),]$v13_bin<-29
test_set[which(v13>5132 & v13<=5245),]$v13_bin<-30
test_set[which(v13>5245 & v13<=5360),]$v13_bin<-31
test_set[which(v13>5360 & v13<=5500),]$v13_bin<-32
test_set[which(v13>5500 & v13<=5646),]$v13_bin<-33
test_set[which(v13>5646 & v13<=5781),]$v13_bin<-34
test_set[which(v13>5781 & v13<=5890),]$v13_bin<-35
test_set[which(v13>5890 & v13<=6011),]$v13_bin<-36
test_set[which(v13>6011 & v13<=6128),]$v13_bin<-37
test_set[which(v13>6128 & v13<=6289.5),]$v13_bin<-38
test_set[which(v13>6289.5 & v13<=6428),]$v13_bin<-39
test_set[which(v13>6428 & v13<=6570),]$v13_bin<-40
test_set[which(v13>6570 & v13<=6715),]$v13_bin<-41
test_set[which(v13>6715 & v13<=6865),]$v13_bin<-42
test_set[which(v13>6865 & v13<=7027),]$v13_bin<-43
test_set[which(v13>7027 & v13<=7200),]$v13_bin<-44
test_set[which(v13>7200 & v13<=7362),]$v13_bin<-45
test_set[which(v13>7362 & v13<=7495),]$v13_bin<-46
test_set[which(v13>7495 & v13<=7671),]$v13_bin<-47
test_set[which(v13>7671 & v13<=7842),]$v13_bin<-48
test_set[which(v13>7842 & v13<=7999),]$v13_bin<-49
test_set[which(v13>7999 & v13<=8165),]$v13_bin<-50
test_set[which(v13>8165 & v13<=8371),]$v13_bin<-51
test_set[which(v13>8371 & v13<=8545),]$v13_bin<-52
test_set[which(v13>8545 & v13<=8760),]$v13_bin<-53
test_set[which(v13>8760 & v13<=8960),]$v13_bin<-54
test_set[which(v13>8960 & v13<=9164.5),]$v13_bin<-55
test_set[which(v13>9164.5 & v13<=9378),]$v13_bin<-56
test_set[which(v13>9378 & v13<=9570),]$v13_bin<-57
test_set[which(v13>9570 & v13<=9766),]$v13_bin<-58
test_set[which(v13>9766 & v13<=9973),]$v13_bin<-59
test_set[which(v13>9973 & v13<=10160),]$v13_bin<-60
test_set[which(v13>10160 & v13<=10363),]$v13_bin<-61
test_set[which(v13>10363 & v13<=10609),]$v13_bin<-62
test_set[which(v13>10609 & v13<=10921),]$v13_bin<-63
test_set[which(v13>10921 & v13<=11228),]$v13_bin<-64
test_set[which(v13>11228 & v13<=11530),]$v13_bin<-65
test_set[which(v13>11530 & v13<=11836),]$v13_bin<-66
test_set[which(v13>11836 & v13<=12120),]$v13_bin<-67
test_set[which(v13>12120 & v13<=12382),]$v13_bin<-68
test_set[which(v13>12382 & v13<=12690),]$v13_bin<-69
test_set[which(v13>12690 & v13<=12992),]$v13_bin<-70
test_set[which(v13>12992 & v13<=13304),]$v13_bin<-71
test_set[which(v13>13304 & v13<=13730),]$v13_bin<-72
test_set[which(v13>13730 & v13<=14150),]$v13_bin<-73
test_set[which(v13>14150 & v13<=14703),]$v13_bin<-74
test_set[which(v13>14703 & v13<=15220),]$v13_bin<-75
test_set[which(v13>15220 & v13<=15730),]$v13_bin<-76
test_set[which(v13>15730 & v13<=16286),]$v13_bin<-77
test_set[which(v13>16286 & v13<=16873),]$v13_bin<-78
test_set[which(v13>16873 & v13<=17370),]$v13_bin<-79
test_set[which(v13>17370 & v13<=17985),]$v13_bin<-80
test_set[which(v13>17985 & v13<=18564),]$v13_bin<-81
test_set[which(v13>18564 & v13<=19229),]$v13_bin<-82
test_set[which(v13>19229 & v13<=20162),]$v13_bin<-83
test_set[which(v13>20162 & v13<=21154),]$v13_bin<-84
test_set[which(v13>21154 & v13<=21875),]$v13_bin<-85
test_set[which(v13>21875 & v13<=22882),]$v13_bin<-86
test_set[which(v13>22882 & v13<=23912),]$v13_bin<-87
test_set[which(v13>23912 & v13<=25067),]$v13_bin<-88
test_set[which(v13>25067 & v13<=26631),]$v13_bin<-89
test_set[which(v13>26631 & v13<=28411),]$v13_bin<-90
test_set[which(v13>28411 & v13<=30741),]$v13_bin<-91
test_set[which(v13>30741 & v13<=33084),]$v13_bin<-92
test_set[which(v13>33084 & v13<=36639),]$v13_bin<-93
test_set[which(v13>36639 & v13<=41240),]$v13_bin<-94
test_set[which(v13>41240 & v13<=46406),]$v13_bin<-95
test_set[which(v13>46406 & v13<=54879),]$v13_bin<-96
test_set[which(v13>54879 & v13<=67686),]$v13_bin<-97
test_set[which(v13>67686 & v13<=98286),]$v13_bin<-98
test_set[which(v13>98286),]$v13_bin<-99
detach(test_set)
#将原始变量用训练集上WOE值替换
test_set<-test_set[,-which(names(test_set)=="v3")]
test_set<-test_set[,-which(names(test_set)=="v13")]
2、验证数据集Lift图
pre=predict(glm_fit,test_set,type="response") #用模型对测试数据进行预测
#测试集真实值
true_value<-test_set$flag
#lift曲线
######################################################################
#函数功能：画出lift图
#参数说明：pre.p：预测值（概率）、true_value：真实值
lift_fun<-function(pre.p,true_value){
ntot<-length(true_value)
apr<-sum(true_value)/ntot
min_pre<-min(pre.p)
max_pre<-max(pre.p)
plevel<-seq(0,max_pre,by=0.001)
depth<-c()
lift<-c()
for (i in plevel){
predicted=1*(pre.p>i)
depthi<-sum(predicted)/ntot
if(i==1){
lifti=0
} else {
lifti<-(sum(true_value & predicted)/sum(predicted))/apr
}
depth<-c(depth,depthi)
lift<-c(lift,lifti)
}
plot(depth,lift,type='l',main='lift曲线')
return(list(depth,lift))
}
lift_fun(pre,true_value) ##画出Lift图
营销策略类模型重点关注Lift
3、验证集混淆矩阵、精准度等指标
######################################################################
#函数功能：计算准确率、精准率、召回率、F1值
#参数说明：pre.p：预测值（概率）、true_value：真实值、plevel：预测概率的阀值
conf_index<-function(pre.d,true_value,plevel){
predicted<-1*(pre.d>plevel)
conf_matrix<-table(true_value,predicted) #混淆矩阵
tp<-sum(true_value & predicted) #正确预测到的响应的数量
pp<-sum(predicted) #预测的响应个数
ap<-sum(true_value) #实际上响应的个数
totn<-length(true_value) #总数n
precision<-tp/pp #命中率precision
recall<-tp/ap #覆盖率（召回率）recall
accuracy<-sum(true_value==predicted)/totn #准确率
F_measure=2*precision*recall/(precision+recall) #F值
return(list(conf_matrix=conf_matrix,accuracy=accuracy,precision=precision,recall=recall,F1_score=F_measure))
}
conf_index(pre,true_value,0.5) ##plevel取0.5（若p>0.5，则预测其响应）
分析结果表明，该模型在验证集上的准确率为87.86%、精确率82.64%，F1值为80.93%，整体效果较好。
通过建立统计模型，用未来用户可能购买的概率给用户打上标签，进行等级分类，营销人员可以以此作为分群营销的依据。
1139
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
