satisfaction字体

员工离职预测案例-实验手册

一．背景介绍

该实例以一家公司为例，他们想了解为什么一些最有经验和最有经验的员工会提前离

职。该公司希望预测哪些有价值的员工将离职。

该实例的目标是预测是否的员工已经离开了；

度量标准是正确预测的雇员的百分比。

二．数据简介

利用这个数据库，并尝试预测哪些有价值的员工将离开下一步。数据集中的字段包括：

员工满意度、最后的评价、一些项目、每月平均时间、花在公司的时间、他们是否发生过工

伤事故、在过去的5年里他们是否升职了、所处部门、工资、员工是否已经离开。

数据集下载地址

(/c/sm/data)

第一步导入所需的包

library(plyr)#Rmisc的关联包,若同时需要加载dplyr包，必须先加载plyr包

library(dplyr)#filter()

library(ggplot2)#ggplot()

变量类

型

变量名变量名翻译详细说明取值范围备注

因变量

left

是否已经离职

定性变量

共

2

个水平

0

代表未离职

1

代表已经离职

已经离职占

23.81%

自变量

satisfaction_level

对公司的满意

程度

0~1

平均满意程度为

0.6

last_evaluation

绩效评估

0~1

平均绩效评估为

0.7

number_project

参加过的项目

数

单位：个

2~7

平均参加

4

个项目

average_montly_h

ours

平均每月工作

时长

单位：小时

96~310

time_spend_compa

ny

每天在公司时

长

单位：小时

2~10

Work_accident

是否发生过工

作差错

定性变量

共

2

个水平

0

代表未发生

1

代表已经发生

发生工作差错的占

14.46%

promotion_last_5y

ears

五年内是否升

职

定性变量

共

2

个水平

0

代表未升职

1

代表已经升职

升职的占

21.27%

sales

职业

定性变量

共

10

个水平

accounting

、

hr

等

salary

薪资水平

定性变量

共

3

个水平

medium

high

、

low

high

占

8.25%

low

占

48.78%

library(DT)#datatable()建立交互式数据表

library(caret)#createDataPartition()分层抽样函数

library(rpart)#rpart()

library(e1071)#naiveBayes()

library(randomForest)#randomForest()

library(pROC)#roc()

library(Rmisc)#multiplot()分割绘图区域

第二步导入数据

hr<-("D/HR_comma_")

第三步描述性分析

str(hr)#查看数据的基本数据结构

summary(hr)#计算数据的主要描述统计量

通过观察各个变量的主要描述统计量可知，离职率将近24%、对公司的满意度在62%

左右、绩效评估在约72%左右、平均每人参加过3-4个项目、员工每月平均工作时长在200

小时左右

hr$left<-factor(hr$left,levels=c('0','1'))

后续的个别模型需要目标变量必须为因子型，我们将其转换为因子型

box_sat<-ggplot(hr,aes(x=left,y=satisfaction_level,fill=left))+

geom_boxplot(varwidth=T)+#varwidth=T意味着箱子的宽度根据样本数决定

theme_bw()+#一种ggplot的主题

#在图中标识均值点，fun.y='mean'为求均值，geom='point'为绘制点图，

#后面的是那个参数就是控制点的形状、大小和填充颜色

stat_summary(fun.y='mean',geom='point',shape=23,size=3,fill='white')+

labs(x='left',y='satisfaction_level')+#设置横纵坐标标签

#设置刻度标签字体大小，rel()控制原始字号的倍数

theme(.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)),

.x=element_text(size=rel(1.3)),

#设置坐标轴标签字体大小

.y=element_text(size=rel(1.3)))

#绘制绩效评估与是否离职的箱线图

box_eva<-ggplot(hr,aes(x=left,y=last_evaluation,fill=left))+

geom_boxplot(varwidth=T)+

theme_bw()+

stat_summary(fun.y='mean',geom='point',shape=23,size=3,fill='white')+

labs(x='left',y='last_evaluation')+

theme(.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)),

.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)))

#绘制平均月工作时长与是否离职的箱线图

box_mon<-ggplot(hr,aes(x=left,y=average_montly_hours,fill=left))+

geom_boxplot(varwidth=T)+

theme_bw()+

stat_summary(fun.y='mean',geom='point',shape=23,size=3,fill='white')+

labs(x='left',y='average_montly_hours')+

theme(.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)),

.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)))

#合并这些图形在一个绘图区域，cols=3的意思就是排版为一行三列

multiplot(box_sat,box_eva,box_mon,cols=3)

探索员工对公司满意度、绩效评估和月均工作时长与是否离职的关系，绘制对公司满意

度与是否离职的箱线图

通过探索员工对公司满意度、绩效评估和月均工作时长与离职的关系可知，离职员工的

特点为对公司的满意度较低，大多集中在0.4左右；绩效评估较高，在0.8以上的较为集中；

平均月工作时长较高，一多半超过了平均水平（200小时）

#绘制参与项目个数条形图时需要把此变量转换为因子型

hr$number_project<-factor(hr$number_project,

levels=c('2','3','4','5','6','7'))

bar_pro<-ggplot(hr,aes(x=number_project,fill=left))+

geom_bar(position='fill')+#position='fill'即绘制百分比堆积条形图

theme_bw()+

labs(x='left',y='number_project')+

theme(.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)),

.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)))

#绘制5年内是否升职与是否离职的百分比堆积条形图

bar_5years<-ggplot(hr,aes(x=(promotion_last_5years),fill=left))+

geom_bar(position='fill')+

theme_bw()+

labs(x='left',y='promotion_last_5years')+

theme(.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)),

.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)))

#绘制薪资与是否离职的百分比堆积条形图

bar_salary<-ggplot(hr,aes(x=salary,fill=left))+

geom_bar(position='fill')+

theme_bw()+

labs(x='left',y='salary')+

theme(.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)),

.x=element_text(size=rel(1.3)),

.y=element_text(size=rel(1.3)))

#合并这些图形在一个绘图区域，cols=3的意思就是排版为一行三列

multiplot(bar_pro,bar_5years,bar_salary,cols=3)

探索参与项目个数、五年内有没有升职和薪资与离职的关系，绘制参与项目个数与是否

离职的百分比堆积条形图

通过探索参与项目个数、五年内有没有升职和薪资与离职的关系可知，参加项目数越多

的员工离职率越大（去除项目数为2的样本）、五年内没有升职的员工的离职率比较大、薪

资越高离职率越低

第四步提取优秀员工

#filter()用来筛选符合条件的样本

hr_model<-filter(hr,last_evaluation>=0.70|time_spend_company>=4

|number_project>5)

第五步自定义交叉验证方法

#设置5折交叉验证method=‘cv’是设置交叉验证方法，number=5意味着是5折交叉

验证

train_control<-trainControl(method='cv',number=5)

第六步分层抽样

(1234)#设置随机种子，为了使每次抽样结果一致

#根据数据的因变量进行7:3的分层抽样，返回行索引向量p=0.7就意味着按照7:3进行

抽样，

#list=F即不返回列表，返回向量

index<-createDataPartition(hr_model$left,p=0.7,list=F)

traindata<-hr_model[index,]#提取数据中的index所对应行索引的数据作为训练集

testdata<-hr_model[-index,]#其余的作为测试集

第七步回归树建模

#使用caret包中的trian函数对训练集使用5折交叉的方法建立决策树模型

#left~.的意思是根据因变量与所有自变量建模；trCintrol是控制使用那种方法进行建模

#methon就是设置使用哪种算法

rpartmodel<-train(left~.,data=traindata,

trControl=train_control,method='rpart')

#利用rpartmodel模型对测试集进行预测，（[-7]的意思就是剔除测试集的因变量这一列）

pred_rpart<-predict(rpartmodel,testdata[-7])

#建立混淆矩阵，positive=‘1’设定我们的正例为“1”

con_rpart<-confusionMatrix(testdata$left,pred_rpart,positive='1')

con_rpart

实际值

预测值01

0228245

187517

通过计算得查准率为85.60%，查全率为91.99%

第八步特征选择（随机森林）

#构建rfe函数的控制参数(使用随机森林函数和5折交叉验证进行以后的特征选择)

rfeControls_rf<-rfeControl(

functions=rfFuncs,#设置使用那种算法进行特征选择

method='cv',#设置交叉验证的方法

number=5)#确定是5折交叉验证

#使用rfe函数（封装法）进行特征选择

(1234)

fs_rf<-rfe(x=traindata[,-7],#剔除训练集的因变量

y=traindata[,7],#提取因变量

sizes=q(3,8,1),#选取的最少的特征是3个，最多是8个

rfeControl=rfeControls_rf)#加入我们构建的控制参数

fs_rf#展示特征选择的结果

new_vars<-fs_rf$optVariables[1:6]#虽然显示选取9个变量，但是根据实际情况，选择6个

mydata<-hr_model[c(new_vars,'left')]#提取原数据中特征选择后的变量作为新数据

traindata2<-mydata[index,]#建立新的训练集

testdata2<-mydata[-index,]#建立新的测试集

(1234)#设置随机种子，使随机森林的随机性确定，否则会导致每次运行结果

不同

#使用train函数对新训练集使用5折交叉验证的方法建立随机森林模型

rfmodel<-train(left~.,data=traindata2,trControl=train_control,method='rf')

pred_rf<-predict(rfmodel,testdata2[-7])

con_rf<-confusionMatrix(pred_rf,testdata2$left,positive='1')

con_rf

实际值

预测值01

0232427

13577

通过计算得查准率为99.48%，查全率为95.53%

第九步朴素贝叶斯建模

e1071model<-train(left~.,data=traindata,

trControl=train_control,method='nb')

pred_nb<-predict(e1071model,testdata[-7])

con_nb<-confusionMatrix(pred_nb,testdata$left,positive='1')

con_nb

实际值

预测值01

02309232

118372

通过计算得查准率为95.38%，查全率为61.59%

第十步特征选择(朴素贝叶斯)

#构建rfe函数的控制参数(使用朴素贝叶斯函数和5交叉验证进行后续的特征选择)

rfeControls_nb<-rfeControl(

functions=nbFuncs,

method='cv',

number=5)

#使用rfe函数（封装法）进行特征选择

fs_nb<-rfe(x=traindata[,-7],

y=traindata[,7],

sizes=q(3,8,1),

rfeControl=rfeControls_nb)

fs_nb

new_vars<-fs_nb$optVariables

mydata<-hr_model[c(new_vars,'left')]

traindata3<-mydata[index,]

testdata3<-mydata[-index,]

nbmodel<-train(left~.,data=traindata3,trControl=train_control,method='nb')

pred_nb2<-predict(nbmodel,testdata3[-7])

con_nb2<-confusionMatrix(pred_nb2,testdata3$left,positive='1')

con_nb2

实际值

预测值01

0226497

163507

通过计算得查准率为88.95%，查全率为83.94%

第十一步逻辑斯蒂回归建模

gmlmodel<-train(left~.,data=traindata,

trControl=train_control,method='LogitBoost')

pred_log<-predict(gmlmodel,testdata[-7])

con_log<-confusionMatrix(pred_log,testdata$left,positive='1')

con_log

实际值

预测值01

0228180

146524

通过计算得查准率为91.93%，查全率为86.75%

查全率（召回率）：真正例占实际正例的比例

查准率（准确率）：真正例占预测正例的比例

而我们的案例中，显然离职的员工是正例，更关注将要离职的员工被成功预测出来（查

全率）

模型查全率查准率

朴素贝叶斯61.59%95.38%

特征选择+朴素贝叶斯83.94%88.95%

逻辑斯蒂回归86.75%91.93%

回归树91.99%85.60%

特征选择+随机森林95.53%99.48%

通过对比模型我们可以发现经过特征选择过的随机森林为最佳模型

第十二步绘制ROC曲线

#使用roc函数时，预测的值必须是数值型

pred_rpart<-c(pred_rpart)

pred_rf<-c(pred_rf)

pred_nb<-c(pred_nb)

pred_nb2<-c(pred_nb2)

pred_log<-c(pred_log)

roc_rpart<-roc(testdata$left,pred_rpart)#获取后续画图时使用的信息

Specificity<-roc_rpart$specificities#为后续的横纵坐标轴奠基

Sensitivity<-roc_rpart$nsitivities#为后续的横纵坐标轴奠基

#绘制ROC曲线

p_rpart<-ggplot(data=NULL,aes(x=1-Specificity,y=Sensitivity))+

geom_line(colour='red')+#绘制ROC曲线

geom_abline()+#绘制对角线

annotate('text',x=0.4,y=0.5,label=paste('AUC=',

round(roc_rpart$auc,3)))+theme_bw()+#在图中（0.4,0.5）处添加AUC值

#在图中右下角坐标（0.95,0.05）添加算法名称

annotate('text',x=0.95,y=0.05,label='rpart',size=8)+

labs(x='1-Specificity',y='Sensitivities')#设置横纵坐标轴标签

p_rpart

roc_rf<-roc(testdata$left,pred_rf)

Specificity<-roc_rf$specificities

Sensitivity<-roc_rf$nsitivities

p_rf<-ggplot(data=NULL,aes(x=1-Specificity,y=Sensitivity))+

geom_line(colour='red')+geom_abline()+

annotate('text',x=0.4,y=0.5,label=paste('AUC=',

round(roc_rf$auc,3)))+theme_bw()+

annotate('text',x=0.95,y=0.05,label='rf',size=8)+

labs(x='1-Specificity',y='Sensitivities')

p_rf

roc_nb<-roc(testdata$left,pred_nb)

Specificity<-roc_nb$specificities

Sensitivity<-roc_nb$nsitivities

p_nb<-ggplot(data=NULL,aes(x=1-Specificity,y=Sensitivity))+

geom_line(colour='red')+geom_abline()+

annotate('text',x=0.4,y=0.5,label=paste('AUC=',

round(roc_nb$auc,3)))+theme_bw()+

annotate('text',x=0.95,y=0.05,label='nb',size=8)+

labs(x='1-Specificity',y='Sensitivities')

p_nb

roc_nb2<-roc(testdata$left,pred_nb2)

Specificity<-roc_nb2$specificities

Sensitivity<-roc_nb2$nsitivities

p_nb2<-ggplot(data=NULL,aes(x=1-Specificity,y=Sensitivity))+

geom_line(colour='red')+geom_abline()+

annotate('text',x=0.4,y=0.5,label=paste('AUC=',

round(roc_nb2$auc,2)))+theme_bw()+

annotate('text',x=0.95,y=0.05,label='nb2',size=8)+

labs(x='1-Specificity',y='Sensitivities')

p_nb2

roc_log<-roc(testdata$left,pred_log)

Specificity<-roc_log$specificities

Sensitivity<-roc_log$nsitivities

p_log<-ggplot(data=NULL,aes(x=1-Specificity,y=Sensitivity))+

geom_line(colour='red')+geom_abline()+

annotate('text',x=0.4,y=0.5,label=paste('AUC=',

round(roc_log$auc,2)))+theme_bw()+

annotate('text',x=0.9,y=0.05,label='logistic',size=8)+

labs(x='1-Specificity',y='Sensitivities')

p_log

#合并四个ROC曲线图，排版为两行两列

multiplot(p_rpart,p_nb,p_nb2,p_log,cols=2)

四个模型中，除去未进行特征选择的朴素贝叶斯比较差，其他的棋逢对手，AUC值均

在0.91左右，总体来说都还不错。

特征选择后的随机森林的AUC值达到了0.977，比上一页中的四个模型均好，所以我

们最后选用随机森林模型进行预测。

第十三步应用

#使用随机森林模型预测分类的概率，type=‘prob’设置预测结果为离职的概率和不离职

的概率

pred_end<-predict(rfmodel,testdata2[-7],type='prob')

#合并预测结果和预测概率结果

data_end<-cbind(pred_end,pred_rf)

#为预测结果表重命名

names(data_end)<-c('pred.0','pred.1','pred')

#生成一个交互式数据表

datatable(data_end)

这是我们最后的预测数据表：”pred.0“是预测为0（不离职）的概率，相反”pred.1

“是预测为1（离职）的概率，最后列”pred“即是否离职。