《基于Logistic模型的存款产品销售的影响因素实证分析-基于某银行数据集》6200字（论文）

基于Logistic模型的存款产品销售的影响因素实证分析—基于某银行数据集目录TOC\o"1-2"\h\u5208摘要 综合两者结果，我们可以说，最终得到的模型时不够严谨的，因为仅仅从显著性来判断自变量是否对于客户购买存款产品的意愿有影响，是比较片面的。而且从结果来说，我们可以计算各自变量的方差膨胀因子如下：表SEQ表\*ARABIC5各自变量方差膨胀因子自变量agejobmaritaleducationdefault方差膨胀因子1.331.071.221.051.00contactmonthdurationcampaignprevioushousing1.842.431.201.041.331.01cons.conf.idxeuribor3mnr.employedcons.price.idxloanemp.var.rate3.6292.9558.3014.291.0031.49可以看出就业变动率emp.var.rate，消费价格指数cons.price.idx等几个与经济学相关的因素是存在多重共线性的。单从年龄这一角度来说，表SEQ表\*ARABIC6年龄与购买与否的二维列联表年龄合计是否购买年青人中年人中老年人高龄老人不购买118121094611437423975购买17451238387833453合计1355712184153015727428显然，模型直接忽略年龄这一因素对客户是否购买的影响是片面不可取的。图SEQ图\*ARABIC7年龄与客户是否购买的条形统计图但是由于自身知识储备的不足，之前所学习的变量选择的方法均是建立在线性模型的基础上，尝试将因变量做logit变换，得到但是并不满足模型求解条件。另外，在建立Logistic回归模型过程中，并未考虑自变量与自变量之间的交互作用，而是直接考虑的各变量独立作用于因变量。且对于定性数据的分析，还可以采用广义可加模型，通过引入基函数使得模型能够更加贴近真实数据，或者建立对数线性模型，本文不再赘述。参考资料附录具体实现代码：(R语言)########数据预处理########getwd()data<-read.csv("Dataformodeling.csv",header=TRUE)data<-as.data.frame(data)dim(data)#3706918#将unknown看作缺失值删去for(iin1:37069){for(jin1:18){if(data[i,j]=="unknown")data[i,j]=NA}}data<-na.omit(data)dim(data)#2742818names(data)#考虑为变量赋值agelims=range(data$age)#年龄考虑利用其典型分位点作为分割点table(cut(data$age,4))#将年龄分为四段<=36,36-56,57-75,76-95for(iin1:27428){if(data$age[i]<=36)data$age[i]=1if(data$age[i]>=37&&data$age[i]<=56)data$age[i]=2if(data$age[i]>=57&&data$age[i]<=75)data$age[i]=3if(data$age[i]>=76)data$age[i]=4}library(base)unique(data$job)for(iin1:27428){if(data$job[i]=="admin.")data$job[i]=1if(data$job[i]=="services")data$job[i]=2if(data$job[i]=="blue-collar")data$job[i]=3if(data$job[i]=="housemaid")data$job[i]=4if(data$job[i]=="technician")data$job[i]=5if(data$job[i]=="self-employed")data$job[i]=6if(data$job[i]=="unemployed")data$job[i]=7if(data$job[i]=="entrepreneur")data$job[i]=8if(data$job[i]=="retired")data$job[i]=9if(data$job[i]=="student")data$job[i]=10if(data$job[i]=="management")data$job[i]=11}#单身为1，结婚为2，离婚为3unique(data$marital)for(iin1:27428){if(data$marital[i]=="single")data$marital[i]=1if(data$marital[i]=="married")data$marital[i]=2if(data$marital[i]=="divorced")data$marital[i]=3}unique(data$education)#将几个basic的等级合并在一起考虑#文盲为1，基础教育为2，高中文化为3，大学学历为4，basic=c("basic.4y","basic.6y","basic.9y")for(iin1:27428){if(data$education[i]=="illiterate")data$education[i]=1if(data$education[i]%in%basic)data$education[i]=2if(data$education[i]=="high.school")data$education[i]=3if(data$education[i]=="university.degree")data$education[i]=5if(data$education[i]=="professional.course")data$education[i]=4}#有违约记录为1，无违约记录为0unique(data$default)for(iin1:27428){if(data$default[i]=="yes")data$default[i]=1if(data$default[i]=="no")data$default[i]=0}unique(data$housing)#有房产为1，无房产为0for(iin1:27428){if(data$housing[i]=="yes")data$housing[i]=1if(data$housing[i]=="no")data$housing[i]=0}unique(data$loan)#贷款为1，未贷款为0for(iin1:27428){if(data$loan[i]=="yes")data$loan[i]=1if(data$loan[i]=="no")data$loan[i]=0}unique(data$month)#仅剩下十个月for(iin1:27428){if(data$month[i]=="mar")data$month[i]=3if(data$month[i]=="apr")data$month[i]=4if(data$month[i]=="may")data$month[i]=5if(data$month[i]=="jun")data$month[i]=6if(data$month[i]=="jul")data$month[i]=7if(data$month[i]=="aug")data$month[i]=8if(data$month[i]=="sep")data$month[i]=9if(data$month[i]=="oct")data$month[i]=10if(data$month[i]=="nov")data$month[i]=11if(data$month[i]=="dec")data$month[i]=12}unique(data$contact)#贷款为1，未贷款为0for(iin1:27428){if(data$contact[i]=="cellular")data$contact[i]=1if(data$contact[i]=="telephone")data$contact[i]=2}#购买产品赋值为1，不购买产品赋值为0for(iin1:27428){if(data$y[i]=="yes")data$y[i]=1if(data$y[i]=="no")data$y[i]=0}#由于data中部分修改为数据值时格式不是数值型，故引入apply函数使得data中数据全为数值型library(base)variable<-data[,-18]variable=apply(variable,2,as.numeric)y=as.matrix(data[,18])y=apply(y,2,as.numeric)data=as.data.frame(cbind(variable,y))#重新对数据框每一列命名colnames(data)=c("age","job","marital","education","default","housing","loan","contact","month","duration","campaign","previous","emp.var.rate","cons.price.idx","cons.conf.idx","euribor3m","nr.employed","y")dim(data)data[1:25,]write.table(data,file="data1.csv",sep=",",s=TRUE,s=FALSE)########建立模型#########愿意购买产品的人数library(base)y_1=subset(data,data$y==1)dim(y_1)#345318#不愿意购买产品的人数y_0=subset(data,data$y==0)dim(y_0)#2397518#绘图library(vcd)counts=table(data$y)countsbarplot(counts,main="Plot",xlab="no=0,yes=1",ylab="Numbers",col="lightblue")######不考虑其比例选取训练集和测试集######set.seed(1)train=sample(c(TRUE,FALSE),nrow(data),rep=TRUE)test=(!train)glm.fits=glm(y~.,data=data,family=binomial,subset=train)summary(glm.fits)#在测试集上进行检验data.test=data[!train,]#1359318bs=predict(glm.fits,data.test,type="response")mean((bs-y[test])^2)glm.pred=rep(0,13593)glm.pred[bs>=.5]=1table(glm.pred,y[test])y[test]mean(glm.pred==y[test])#预测的正确率library(pROC)roc(glm.pred,y[test],plot=TRUE,print.thres=TRUE,print.auc=TRUE)roc(glm.pred,y[test])######考虑其比例选取训练集和测试集######set.seed(2)train1=sample(c(TRUE,FALSE),nrow(y_1),rep=TRUE)test1=(!train1)train2=sample(c(TRUE,FALSE),nrow(y_0),rep=TRUE)test2=(!train2)trainn=rbind(y_1[train1,],y_0[train2,])colnames(trainn)=c("age","job","marital","education","default","housing","loan","contact","month","duration","campaign","previous","emp.var.rate","cons.price.idx","cons.conf.idx","euribor3m","nr.employed","y")glm.fit1=glm(y~.,data=trainn,family=binomial)summary(glm.fit1)#在测试集上进行检验Test=rbind(y_1[test1,],y_0[test2,])#1376018bs1=predict(glm.fit1,Test,type="response")#用秩缺乏拟合来进行预测的结果很可能不可靠,故下面预测结果不予考虑#mean((bs1-Test$y)^2)#glm.pred1=rep(0,13760)#glm.pred1[bs1>=.5]=1#table(glm.pred1,Test$y)#mean(glm.pred1==Test$y)#预测的正确率########模型改进#########去除系数不显著的项set.seed(1)glm.fitt=glm(y~job+marital+education+contact+month+duration+campaign+previous+emp.var.rate+cons.price.idx+cons.conf.idx+euribor3m+nr.employed,data=data,family=binomial,subset=train)summary(glm.fitt)###修正系数#在测试集上进行检验data.test=data[!train,]#1359318b=predict(glm.fitt,data.test,type="response")mean((b-y[test])^2)glm.pre=rep(0,13593)glm.pre[b>=.5]=1table(glm.pre,y[test])mean(glm.pre==y[test])#预测的正确率#再删去maritalset.seed(1)glm.fit2=glm(y~job+education+contact+month+duration+campaign+previous+emp.var.rate+cons.price.idx+cons.conf.idx+euribor3m+nr.employed,data=data,family=binomial,subset=train)summary(glm.fit2)#在测试集上进行检验data.test=data[!train,]#1359318b2=predict(glm.fit2,data.test,type="response")mean((b2-y[test])^2)glm.pre2=rep(0,13593)glm.pre2[b2>=.5]=1table(glm.pre2,y[test])mean(glm.pre2==y[test])#预测的正确率#比较两个模型的ROC曲线library(pROC)roc1<-roc(glm.pred,y[test])roc2<-roc(glm.pre2,y[test])plot(roc1,col="blue")plot.roc(roc2,add=TRUE,col="red")#绘图看银行联系于客户购买之间的关系Data<-cbind(data.test$month,data.test$duration,data.test$contact,b2)pairs(~data.test$month+data.test$duration+data.test$contact+b2,data=Data,main="BasicScatterPlotMatrix")#绘图看受教育程度对客户购买的影响count1=table(data$y,data$education)count1barplot(count1,main="Education",xlab="Educationdegree",ylab="Numbers",col=c("lightblue","orange"),legend=rownames(count1),width=0.01)#绘图看之前联系的客户的人数的影响count2=table(data$y,data$previous)count2barplot(count2,main="Previouscontact",xlab="Previousnumbers",ylab="Numbers",col=c("lightblue","lightgreen"),legend=rownames(count2))#绘图看年龄count3=table(data$y,data$age)count3barplot(count3,main="AgeInfluence",xlab="Age",ylab="Numbers",col=c("lightblue","grey"),legend=rownames(count3))library(car)vif(glm.fits)#方差膨胀因子#使用最佳子集选择(失败)#由于最佳子集