《基于Logistic模型的存款產(chǎn)品銷售的影響因素實(shí)證分析-基于某銀行數(shù)據(jù)集》6200字（論文）

基于Logistic模型的存款產(chǎn)品銷售的影響因素實(shí)證分析—基于某銀行數(shù)據(jù)集目錄TOC\o"1-2"\h\u5208摘要 綜合兩者結(jié)果，我們可以說，最終得到的模型時(shí)不夠嚴(yán)謹(jǐn)?shù)?，因?yàn)閮H僅從顯著性來判斷自變量是否對于客戶購買存款產(chǎn)品的意愿有影響，是比較片面的。而且從結(jié)果來說，我們可以計(jì)算各自變量的方差膨脹因子如下：表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可以看出就業(yè)變動率emp.var.rate，消費(fèi)價(jià)格指數(shù)cons.price.idx等幾個與經(jīng)濟(jì)學(xué)相關(guān)的因素是存在多重共線性的。單從年齡這一角度來說，表SEQ表\*ARABIC6年齡與購買與否的二維列聯(lián)表年齡合計(jì)是否購買年青人中年人中老年人高齡老人不購買118121094611437423975購買17451238387833453合計(jì)1355712184153015727428顯然，模型直接忽略年齡這一因素對客戶是否購買的影響是片面不可取的。圖SEQ圖\*ARABIC7年齡與客戶是否購買的條形統(tǒng)計(jì)圖但是由于自身知識儲備的不足，之前所學(xué)習(xí)的變量選擇的方法均是建立在線性模型的基礎(chǔ)上，嘗試將因變量做logit變換，得到但是并不滿足模型求解條件。另外，在建立Logistic回歸模型過程中，并未考慮自變量與自變量之間的交互作用，而是直接考慮的各變量獨(dú)立作用于因變量。且對于定性數(shù)據(jù)的分析，還可以采用廣義可加模型，通過引入基函數(shù)使得模型能夠更加貼近真實(shí)數(shù)據(jù)，或者建立對數(shù)線性模型，本文不再贅述。參考資料附錄具體實(shí)現(xiàn)代碼：(R語言)########數(shù)據(jù)預(yù)處理########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)#年齡考慮利用其典型分位點(diǎn)作為分割點(diǎn)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，結(jié)婚為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，基礎(chǔ)教育為2，高中文化為3，大學(xué)學(xué)歷為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)#有房產(chǎn)為1，無房產(chǎn)為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}#購買產(chǎn)品賦值為1，不購買產(chǎn)品賦值為0for(iin1:27428){if(data$y[i]=="yes")data$y[i]=1if(data$y[i]=="no")data$y[i]=0}#由于data中部分修改為數(shù)據(jù)值時(shí)格式不是數(shù)值型，故引入apply函數(shù)使得data中數(shù)據(jù)全為數(shù)值型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))#重新對數(shù)據(jù)框每一列命名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)########建立模型#########愿意購買產(chǎn)品的人數(shù)library(base)y_1=subset(data,data$y==1)dim(y_1)#345318#不愿意購買產(chǎn)品的人數(shù)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")######不考慮其比例選取訓(xùn)練集和測試集######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)#在測試集上進(jìn)行檢驗(yàn)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])#預(yù)測的正確率library(pROC)roc(glm.pred,y[test],plot=TRUE,print.thres=TRUE,print.auc=TRUE)roc(glm.pred,y[test])######考慮其比例選取訓(xùn)練集和測試集######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)#在測試集上進(jìn)行檢驗(yàn)Test=rbind(y_1[test1,],y_0[test2,])#1376018bs1=predict(glm.fit1,Test,type="response")#用秩缺乏擬合來進(jìn)行預(yù)測的結(jié)果很可能不可靠,故下面預(yù)測結(jié)果不予考慮#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)#預(yù)測的正確率########模型改進(jìn)#########去除系數(shù)不顯著的項(xiàng)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)###修正系數(shù)#在測試集上進(jìn)行檢驗(yàn)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])#預(yù)測的正確率#再刪去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)#在測試集上進(jìn)行檢驗(yàn)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])#預(yù)測的正確率#比較兩個模型的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")#繪圖看銀行聯(lián)系于客戶購買之間的關(guān)系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)#繪圖看之前聯(lián)系的客戶的人數(shù)的影響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)#方差膨脹因子#使用最佳子集選擇(失敗)#由于最佳子集