本文详细展示了使用R语言进行客户购买预测的步骤，包括数据清洗、特征工程、逻辑回归和主成分分析。通过对数据的预处理，如处理缺失值、类别变量编码，以及使用皮尔森卡方检验进行特征合并，提高了模型的预测性能。最终通过逻辑回归和朴素贝叶斯模型，得到0.88的得分，验证了模型的有效性。
和鲸社区 客户购买预测练习赛 得分0.88
工具： R软件
A<-read.csv("E:/R语言练习/客户购买预测/train_set.csv",head=T); #读取数据
A1<-A; # 赋值给A1不破坏A
################################ 数据清洗
dim (A1); #查看A1大小
A1<-na.omit(A1);dim(A1);#去掉空值后查看A1 大小，发现没有空值
Q=1;
for(i in 1:ncol(A1)){Q[i]<-class(A1[,i])}
Q;rm(Q); #查看每一列的数据类型
unique(A1[,3]);
unique(A1[,4]);
unique(A1[,5]);
unique(A1[,6]);
unique(A1[,8]);
unique(A1[,9]);
unique(A1[,10]);
unique(A1[,12]);
unique(A1[,17]); #查看每一字符型列的唯一项
A1[,6][A1[,6]=="yes"]=1;
A1[,6][A1[,6]=="no"]=0; #将第6列为yes 都改为1，no改为0
A1[,8][A1[,8]=="yes"]=1;
A1[,8][A1[,8]=="no"]=0; #将第8列为yes 都改为1，no改为0
A1[,9][A1[,9]=="yes"]=1;
A1[,9][A1[,9]=="no"]=0; #将第9列为yes 都改为1，no改为0
A1[,6]<-as.numeric(A1[,6])
A1[,8]<-as.numeric(A1[,8])
A1[,9]<-as.numeric(A1[,9]) #将6,8,9都改为数值型
#通过excel表看到，最后一列（第18列，是否购买)只有数值0和1两种
#第一列是用户的id 数值型
#第二列是用户的年龄,数值型,可以看做连续型变量
#第三列一共有12类
#先对总体做皮尔森卡方检验，看看该变量对响应变量影响大不大
tapply(A1[,18],A1[,3],sum)/tapply(A1[,18],A1[,3],length)
a<-as.numeric(tapply(A1[,18],A1[,3],length))
b<-as.numeric(tapply(A1[,18],A1[,3],sum))
c=a-b
x<-c(b,c)
dim(x)=c(length(x)/2,2)
chisq.test(x)
#发现p<0.05，所以影响很大
#从购买率从高到底两两考虑是否有适合合并的
x<-c(b[9],b[6],c[9],c[6]);dim(x)=c(2,2)
chisq.test(x)
#发现p>0.05，所以student和retired没有太大差异，可以合并，方法为都取为1
#不着急，先把这部分工作做完，后面集体赋值
x<-c(b[9],b[11],c[9],c[11]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第一大和第三大的不能合并
x<-c(b[11],b[5],c[11],c[5]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第三大和第四大的可以合并
x<-c(b[11],b[12],c[11],c[12]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第三大和第五大的可以合并
x<-c(b[11],b[7],c[11],c[7]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第三大和第六大的不能合并
x<-c(b[7],b[1],c[7],c[1]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第六大和第七大的可以合并
x<-c(b[7],b[10],c[7],c[10]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第六大和第八大的可以合并
x<-c(b[7],b[8],c[7],c[8]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第六大和第九大的不能合并
x<-c(b[8],b[4],c[8],c[4]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第九大和第十大的可以合并
x<-c(b[8],b[3],c[8],c[3]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第九大和第十一大的可以合并
x<-c(b[8],b[2],c[8],c[2]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第九大和第十二大的不能合并
#为第三列的变量赋值，并转化成数值型
A1[,3][A1[,3]=="student"| A1[,3]=="retired"]=1
A1[,3][A1[,3]=="unemployed"| A1[,3]=="management"| A1[,3]=="unknown"]=2
A1[,3][A1[,3]=="admin."| A1[,3]=="self-employed"| A1[,3]=="technician"]=3
A1[,3][A1[,3]=="services"| A1[,3]=="housemaid"| A1[,3]=="entrepreneur"]=4
A1[,3][A1[,3]=="blue-collar"]=5
A1[,3]<-as.numeric(A1[,3])
unique(A1[,3])
#第三列处理完毕
#第四列有三类
#先对总体做皮尔森卡方检验，看看该变量对响应变量影响大不大
tapply(A1[,18],A1[,4],sum)/tapply(A1[,18],A1[,4],length)
a<-as.numeric(tapply(A1[,18],A1[,4],length))
b<-as.numeric(tapply(A1[,18],A1[,4],sum))
c<-a-b
x<-c(b,c)
dim(x)=c(length(x)/2,2)
chisq.test(x)
#发现影响很大，现在考虑是否有能合并的项
x<-c(b[1],b[2],c[1],c[2]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第二大和第三大的不能合并
x<-c(b[3],b[1],c[3],c[1]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第一大和第二大的不能合并
#所以现在对三种情况按购买率赋值
A1[,4][A1[,4]=="single"]=1
A1[,4][A1[,4]=="divorced"]=2
A1[,4][A1[,4]=="married"]=3
A1[,4]<-as.numeric(A1[,4])
unique(A1[,4])
#第四列处理完毕
#第五列一共有四类
#先对总体做皮尔森卡方检验，看看该变量对响应变量影响大不大
tapply(A1[,18],A1[,5],sum)/tapply(A1[,18],A1[,5],length)
a<-as.numeric(tapply(A1[,18],A1[,5],length))
b<-as.numeric(tapply(A1[,18],A1[,5],sum))
c=a-b
x<-c(b,c)
dim(x)=c(length(x)/2,2)
chisq.test(x)
#发现p<0.05，所以影响很大
#从购买率从高到底两两考虑是否有适合合并的
x<-c(b[3],b[4],c[3],c[4]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第一大和第二大的可以合并
x<-c(b[3],b[2],c[3],c[2]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第一大和第三大的不能合并
x<-c(b[2],b[1],c[2],c[1]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第三大和第四大的不能合并
##所以现在对四种情况按购买率赋值
A1[,5][A[,5]=="tertiary"|A1[,5]=="unknown"]=1
A1[,5][A[,5]=="secondary"]=2
A1[,5][A[,5]=="primary"]=3
A1[,5]<-as.numeric(A1[,5])
unique(A1[,5])
#第五列处理完毕
#第六列已经完毕
#第七列已经完毕
#第八列已经完毕
#第九列已经完毕
#第十列有三类
#先对总体做皮尔森卡方检验，看看该变量对响应变量影响大不大
tapply(A1[,18],A1[,10],sum)/tapply(A1[,18],A1[,10],length)
a<-as.numeric(tapply(A1[,18],A1[,10],length))
b<-as.numeric(tapply(A1[,18],A1[,10],sum))
c=a-b
x<-c(b,c)
dim(x)=c(length(x)/2,2)
chisq.test(x)
#发现p<0.05，所以影响很大
#从购买率从高到底两两考虑是否有适合合并的
x<-c(b[1],b[2],c[1],c[2]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第一大和第二大的可以合并
x<-c(b[1],b[3],c[1],c[3]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第一大和第三大的不能合并
##所以现在对三种情况按购买率赋值
A1[,10][A1[,10]=="cellular"|A1[,10]=="telephone"]=1
A1[,10][A1[,10]=="unknown"]=0
A1[,10]<-as.numeric(A1[,10])
unique(A1[,10])
#第十列处理完毕
#第十二列有十二类
#先对总体做皮尔森卡方检验，看看该变量对响应变量影响大不大
tapply(A1[,18],A1[,12],sum)/tapply(A1[,18],A1[,12],length)
a<-as.numeric(tapply(A1[,18],A1[,12],length))
b<-as.numeric(tapply(A1[,18],A1[,12],sum))
c=a-b
x<-c(b,c)
dim(x)=c(length(x)/2,2)
chisq.test(x)
#发现p<0.05，所以影响很大
#从购买率从高到底两两考虑是否有适合合并的
x<-c(b[8],b[11],c[8],c[11]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第一大和第二大的可以合并
x<-c(b[8],b[12],c[8],c[12]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第一大和第三大的可以合并
x<-c(b[8],b[3],c[8],c[3]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第一大和第四大的可以合并
x<-c(b[8],b[1],c[8],c[1]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第一大和第五大的不能合并
x<-c(b[1],b[4],c[1],c[4]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第五大和第六大的可以合并
x<-c(b[1],b[5],c[1],c[5]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第五大和第七大的不能合并
x<-c(b[5],b[2],c[5],c[2]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第七大和第八大的可以合并
x<-c(b[5],b[10],c[5],c[10]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第七大和第九大的可以合并
x<-c(b[5],b[7],c[5],c[7]);dim(x)=c(2,2)
chisq.test(x) #p>0.05,第七大和第十大的可以合并
x<-c(b[5],b[6],c[5],c[6]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第七大和第十一大的不能合并
x<-c(b[6],b[9],c[6],c[9]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第十一大和第十二大的不能合并
##所以现在对十二种情况按购买率赋值
A1[,12][A1[,12]=="mar"|A1[,12]=="oct"|
A1[,12]=="sep"|A1[,12]=="dec"]=1
A1[,12][A1[,12]=="apr"|A1[,12]=="feb"]=2
A1[,12][A1[,12]=="jan"|A1[,12]=="nov"|
A1[,12]=="aug"|A1[,12]=="jun"]=3
A1[,12][A1[,12]=="jul"]=4
A1[,12][A1[,12]=="may"]=5
A1[,12]<-as.numeric(A1[,12])
unique(A1[,12])
#第十二列处理完毕
#第十七列有四类
#先对总体做皮尔森卡方检验，看看该变量对响应变量影响大不大
tapply(A1[,18],A1[,17],sum)/tapply(A1[,18],A1[,17],length)
a<-as.numeric(tapply(A1[,18],A1[,17],length))
b<-as.numeric(tapply(A1[,18],A1[,17],sum))
c=a-b
x<-c(b,c)
dim(x)=c(length(x)/2,2)
chisq.test(x)
#发现p<0.05，所以影响很大
#从购买率从高到底两两考虑是否有适合合并的
x<-c(b[3],b[2],c[3],c[2]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第一大和第二大的不能合并
x<-c(b[2],b[1],c[2],c[1]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第二大和第三大的不能合并
x<-c(b[1],b[4],c[1],c[4]);dim(x)=c(2,2)
chisq.test(x) #p<0.05,第三大和第四大的不能合并
##所以现在对四种情况按购买率赋值
A1[,17][A1[,17]=="success"]=1
A1[,17][A1[,17]=="other"]=2
A1[,17][A1[,17]=="failure"]=3
A1[,17][A1[,17]=="unknown"]=4
A1[,17]<-as.numeric(A1[,17])
unique(A1[,17])
#第十七列处理完毕
############################################### 逻辑回归
#先抽取80%作为训练样本A2
a<-sample(1:nrow(A1),0.2*nrow(A1))
b<-setdiff(1:nrow(A1),a)
#选出训练集 80%
A2=A1[-a,];
#剩余20%作为测试集
A3=A1[-b,];
#直接进行逻辑回归
B11<-glm(A2[,18]~A2[,2]+A2[,3]+A2[,4]+A2[,5]+A2[,6]+A2[,7]+A2[,8]+A2[,9]+
A2[,10]+A2[,11]+A2[,12]+A2[,13]+A2[,14]+A2[,15]+A2[,16]+A2[,17]
,family=binomial,data=A2,maxit=100)
summary(B11)
#回归诊断：
source("D:/R软件1/R-4.0.4/bin/i386/回归诊断.R")
C1<-Reg_Diag(B11)
w1<-C1=="*"
w11<-apply(w1,1,sum)
w12<-which(w11>2);length(w12)
A2<-A2[-w12,]
#去掉异常值后回归
B12<-glm(y~age+job+marital+education+default+balance+housing+loan+
contact+day+month+duration+campaign+pdays+previous+poutcome
,family=binomial,data=A2,maxit=100)
summary(B12)
#逐步回归
step(B12)
B13<-glm(formula = y ~ job + marital + education + balance + housing +
loan + contact + month + duration + campaign + pdays + poutcome,
family = binomial, data = A2, maxit = 100)
summary(B13)
#测试集测试结果
A3.pre1<-predict(B13,newdata=A3)
#确认两个向量的长度是否一致
length(A3.pre1);length(A3$y) ;
A33<-exp(A3.pre1)/(1+exp(A3.pre1));
library(pROC); roc(A3$y,A33);
A33[A33>=0.5]=1;
A33[A33<0.5]=0;
unique(A33);unique(A3$y);
sum(A33==1);
A33<-as.factor(A33);A3$y<-as.factor(A3$y);
library(caret) ; #加载混淆矩阵包
confusionMatrix(A33,A3$y) # 混淆矩阵
####################################### 主成分回归
#选出训练集 80%
A2=A1[-a,];
#剩余20%作为测试集
A3=A1[-b,];
#主成分分析
D1<-princomp(~A2[,2]+A2[,3]+A2[,4]+A2[,5]+A2[,6]+A2[,7]+A2[,8]+A2[,9]
+A2[,10]+A2[,11]+A2[,12]+A2[,13]+A2[,14]+A2[,15]+A2[,16]+A2[,17]
, data=A2,cor=T)
summary(D1, loadings=TRUE)
#求出各主成分
pre<-predict(D1)
A2$z1<-pre[,1]; A2$z2<-pre[,2]; A2$z3<-pre[,3]; A2$z4<-pre[,4]; A2$z5<-pre[,5];
A2$z6<-pre[,6]; A2$z7<-pre[,7]; A2$z8<-pre[,8]; A2$z9<-pre[,9]; A2$z10<-pre[,10];
A2$z11<-pre[,11]; A2$z12<-pre[,12]; A2$z13<-pre[,13];A2$z14<-pre[,14];#求出主成分
B14<-glm(A2[,18]~z1+z2+z3+z4+z5+z6+z7+z8+z9+z10+z11+z12+z13+z14,data=A2,family=binomial)
summary(B14)
#回归诊断
C2<-Reg_Diag(B14)
w2<-C2=="*"
w21<-apply(w2,1,sum)
w22<-which(w21>2);length(w22)
A2<-A2[-w22,]
#逐步回归
B15<-glm(A2[,18]~z1+z2+z3+z4+z5+z6+z7+z8+z9+z10+z11+z12+z13+z14,data=A2,family=binomial)
summary(B15)
step(B15)
B16<-glm(formula = A2[, 18] ~ z1 + z2 + z3 + z4 + z5 + z6 + z7 + z8 +
z9 + z10 + z13, family = binomial, data = A2)
summary(B16)
B17<-glm(formula = A2[, 18] ~ z1 + z2 + z4 + z5 + z6 + z7 + z8 +
z9 + z13, family = binomial, data = A2)
summary(B17)
beta<-coef(B17); E<-loadings(D1)
x.bar<-D1$center; x.sd<-D1$scale
coef<-(beta[2]*E[,1]+ beta[3]*E[,2]+beta[4]*E[,3]+beta[5]*E[,4]+
beta[6]*E[,5]+beta[7]*E[,6]+beta[8]*E[,7]+beta[9]*E[,8]+beta[10]*E[,9])/x.sd
beta0 <- beta[1]- sum(x.bar * coef)
c(beta0, coef)
A3.pre2<-as.matrix(A3[,2:17])%*%as.matrix(coef)+beta0
#测试集测试：
A3.pre2<-predict(B12,newdata=A3)
length(A3.pre2);length(A3$y)
A33<-exp(A3.pre2)/(1+exp(A3.pre2))
roc(A3$y,A33);
A33[A33>=0.5]=1
A33[A33<0.5]=0
unique(A33);unique(A3$y)
sum(A33==1)
A33<-as.factor(A33);A3$y<-as.factor(A3$y);
library(caret)
confusionMatrix(A33,A3$y)
#可见做完主成分回归再逻辑回归，改变不大
######################################### 朴素贝叶斯
#选出训练集 80%
A2=A1[-a,];
#剩余20%作为测试集
A3=A1[-b,];
library(e1071) #加载贝叶斯包
#直接贝叶斯估计
B31<-naiveBayes(y~age+job+marital+education+default+
balance+housing+loan+contact+day+month+
duration+campaign+pdays+previous+poutcome,data=A2)
A3.pre31<- predict(B31,A3,type="class");
A3.pre31<-as.factor(A3.pre31);A3$y<-as.factor(A3$y);
confusionMatrix(A3.pre31,A3$y)
#去掉异常值朴素贝叶斯 ，此处异常值按照逻辑回归中的
A2<-A2[-w12,]
B32<-naiveBayes(y~age+job+marital+education+default+
balance+housing+loan+contact+day+month+
duration+campaign+pdays+previous+poutcome,data=A2)
A3.pre32<- predict(B32,A3,type="class");
A3.pre32<-as.factor(A3.pre32);A3$y<-as.factor(A3$y);
confusionMatrix(A3.pre32,A3$y)
#贝叶斯效果不如逻辑回归的好，正确率只有0.84
#现在以所有样本作为训练集，对网站给的数据做测试，不做主成分回归，做普通的逻辑回归
A2<-A1
B21<-glm(A2[,18]~A2[,2]+A2[,3]+A2[,4]+A2[,5]+A2[,6]+A2[,7]+A2[,8]+A2[,9]+
A2[,10]+A2[,11]+A2[,12]+A2[,13]+A2[,14]+A2[,15]+A2[,16]+A2[,17]
,family=binomial,data=A2,maxit=100)
summary(B21)
C3<-Reg_Diag(B21)
w3<-C3=="*";
w31<-apply(w3,1,sum)
w32<-which(w31>1);length(w32)
A2<-A2[-w32,];
B22<-glm(y~age+job+marital+education+default+balance+housing+loan+
contact+day+month+duration+campaign+pdays+previous+poutcome,family=binomial,data=A2,maxit=200)
summary(B22)
#逐步回归
step(B22)
B23<-glm(formula = y ~ job + marital + education + balance +
housing + loan + contact + month + duration + campaign +
pdays + poutcome, family = binomial, data = A2, maxit = 100)
summary(B23)
#读取测试集
AA<-read.csv("E:/R语言练习/客户购买预测/test_set.csv",head=T)
#数据整理
AA1<-AA;
sum(is.na(AA1));
AA1[,6][AA1[,6]=="yes"]=1;
AA1[,6][AA1[,6]=="no"]=0; #将第6列为yes 都改为1，no改为0
AA1[,8][AA1[,8]=="yes"]=1;
AA1[,8][AA1[,8]=="no"]=0; #将第8列为yes 都改为1，no改为0
AA1[,9][AA1[,9]=="yes"]=1;
AA1[,9][AA1[,9]=="no"]=0; #将第9列为yes 都改为1，no改为0
AA1[,6]<-as.numeric(AA1[,6])
AA1[,8]<-as.numeric(AA1[,8])
AA1[,9]<-as.numeric(AA1[,9]) #将6,8,9都改为数值型
#第三列
AA1[,3][AA1[,3]=="student"| AA1[,3]=="retired"]=1
AA1[,3][AA1[,3]=="unemployed"| AA1[,3]=="management"| AA1[,3]=="unknown"]=2
AA1[,3][AA1[,3]=="admin."| AA1[,3]=="self-employed"| AA1[,3]=="technician"]=3
AA1[,3][AA1[,3]=="services"| AA1[,3]=="housemaid"| AA1[,3]=="entrepreneur"]=4
AA1[,3][AA1[,3]=="blue-collar"]=5
AA1[,3]<-as.numeric(AA1[,3])
unique(AA1[,3])
#第四列
AA1[,4][AA1[,4]=="single"]=1
AA1[,4][AA1[,4]=="divorced"]=2
AA1[,4][AA1[,4]=="married"]=3
AA1[,4]<-as.numeric(AA1[,4])
unique(AA1[,4])
#第五列
AA1[,5][AA1[,5]=="tertiary"|AA1[,5]=="unknown"]=1
AA1[,5][AA1[,5]=="secondary"]=2
AA1[,5][AA1[,5]=="primary"]=3
AA1[,5]<-as.numeric(AA1[,5])
unique(AA1[,5])
#第十列
AA1[,10][AA1[,10]=="cellular"|AA1[,10]=="telephone"]=1
AA1[,10][AA1[,10]=="unknown"]=0
AA1[,10]<-as.numeric(AA1[,10])
unique(AA1[,10])
#第十二列
AA1[,12][AA1[,12]=="mar"|AA1[,12]=="oct"|
AA1[,12]=="sep"|AA1[,12]=="dec"]=1
AA1[,12][AA1[,12]=="apr"|AA1[,12]=="feb"]=2
AA1[,12][AA1[,12]=="jan"|AA1[,12]=="nov"|
AA1[,12]=="aug"|AA1[,12]=="jun"]=3
AA1[,12][AA1[,12]=="jul"]=4
AA1[,12][AA1[,12]=="may"]=5
AA1[,12]<-as.numeric(AA1[,12])
unique(AA1[,12])
#第十七列
AA1[,17][AA1[,17]=="success"]=1
AA1[,17][AA1[,17]=="other"]=2
AA1[,17][AA1[,17]=="failure"]=3
AA1[,17][AA1[,17]=="unknown"]=4
AA1[,17]<-as.numeric(AA1[,17])
unique(AA1[,17])
#预测
AA1.pre1<-predict(B23,newdata=AA1)
AA1.P<-exp(AA1.pre1)/(1+exp(AA1.pre1));
write.table(AA1.P,"E:/R语言练习/客户购买预测/t1.csv",row.names=FALSE,col.names=TRUE,sep=",")
56
被折叠的 条评论
为什么被折叠?
到【灌水乐园】发言
