用R语言分析与预測员工离职

作者简单介绍

糖甜甜甜，R语言中文社区专栏作者

公众号：经管人学数据分析

在实验室搬砖之后，继续我们的kaggle数据分析之旅，这次数据也是答主在kaggle上选择的比較火的一份关于人力资源的数据集，关注点在于员工离职的分析和预測，依旧还是从数据读取，数据预处理，EDA和机器学习建模这几个部分開始进行，最后使用集成学习中比較火的random forest算法来预測离职情况。

数据读取

setwd("E:/kaggle/human resource") library(data.table) library(plotly) library(corrplot) library(randomForest) library(pROC) library(tidyverse) library(caret) hr<-as.tibble(fread("HR_comma_sep.csv")) glimpse(hr) sapply(hr,function(x){sum(is.na(x))}) ———————————————————————————————————————————————————————————————————————————————————— Observations: 14,999 Variables: 10 $ satisfaction_level     0.38, 0.80, 0.11, 0.72, 0.37, 0.41, 0.10, 0.92, 0.89, 0.42, 0.45, 0.11, 0.84, 0.41, 0.36, 0.38, 0.45, 0.78, 0.45, 0.76, 0.11, 0.3... $ last_evaluation       0.53, 0.86, 0.88, 0.87, 0.52, 0.50, 0.77, 0.85, 1.00, 0.53, 0.54, 0.81, 0.92, 0.55, 0.56, 0.54, 0.47, 0.99, 0.51, 0.89, 0.83, 0.5... $ number_project         2, 5, 7, 5, 2, 2, 6, 5, 5, 2, 2, 6, 4, 2, 2, 2, 2, 4, 2, 5, 6, 2, 6, 2, 2, 5, 4, 2, 2, 2, 6, 2, 2, 2, 4, 6, 2, 2, 6, 2, 5, 2, 2, ... $ average_montly_hours   157, 262, 272, 223, 159, 153, 247, 259, 224, 142, 135, 305, 234, 148, 137, 143, 160, 255, 160, 262, 282, 147, 304, 139, 158, 242,... $ time_spend_company     3, 6, 4, 5, 3, 3, 4, 5, 5, 3, 3, 4, 5, 3, 3, 3, 3, 6, 3, 5, 4, 3, 4, 3, 3, 5, 5, 3, 3, 3, 4, 3, 3, 3, 6, 4, 3, 3, 4, 3, 5, 3, 3, ... $ Work_accident         0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ... $ left                   1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, 1, ... $ promotion_last_5years 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 1, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, ... $ sales                 "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sales", "sa... $ salary                 "low", "medium", "medium", "low", "low", "low", "low", "low", "low", "low", "low", "low", "low", "low", "low", "low", "low", "low... satisfaction_level       last_evaluation        number_project  average_montly_hours    time_spend_company         Work_accident                  left                    0                     0                     0                     0                     0                     0                     0 promotion_last_5years                 sales                salary                    0                     0                     0

数据集情况例如以下。一共10维数据，14999个观測值。变量的代表名称各自是
satisfaction_level--惬意度，last_evaluation--最后一次评估，number_project--參与项目数量。average_montly_hours--每月平均工作时间。time_spend_company--公司停留时间。Work_accident--工作事故次数，left--是否离职。promotion_last_5years--过去五年升值状况，sales--工种，salary--工资。

并且简单的观測了一下。没有发现缺失值，那么我就能够直接进入数据分析阶段了。

数据预处理

依据每个特征的数值情况。我们能够将不少特征因子化，方便后期做不同类别的差异分析。

hr$sales<-as.factor(hr$sales) hr$salary<-as.factor(hr$salary) hr$left<-as.factor(hr$left) hr$Work_accident<-as.factor(hr$Work_accident) hr$left<-recode(hr$left,'1'="yes",'0'="no") hr$promotion_last_5years<-as.factor(hr$promotion_last_5years)

看的出大部分数据都是数值型的。我们使用相关性来衡量不同变量之间的相关性高低：

cor.hr<-hr %>% select(-sales,-salary) cor.hr$Work_accident<-as.numeric(as.character(cor.hr$Work_accident)) cor.hr$promotion_last_5years<-as.numeric(as.character(cor.hr$promotion_last_5years)) cor.hr$left<-as.numeric(as.character(cor.hr$left)) corrplot(corr = cor(cor.hr),type = "lower",method = "square",title="变量相关性",order="AOE")

直观的来看。是否离职和惬意度高低就有非常高的关联性啊。

EDA

ggplot(group_by(hr,sales),aes(x=sales,fill=sales))+geom_bar(width = 1)+coord_polar(theta = "x")+ggtitle("不同职业的人数") ggplot(hr,aes(x=sales,y=satisfaction_level,fill=sales))+geom_boxplot()+ggtitle("不同职业的惬意度")+stat_summary(fun.y = mean,size=3,color='white',geom = "point")+  theme(legend.position = "none") ggplot(hr,aes(x=sales,y=satisfaction_level,fill=left))+geom_boxplot()+ggtitle("不同职业的惬意度") ggplot(hr,aes(x=sales,y=average_montly_hours,fill=left))+geom_boxplot()+ggtitle("不同职业的工作时长") ggplot(hr,aes(x=sales,y=number_project,fill=left))+geom_boxplot()+ggtitle("不同职业的项目情况")

首先观察不同岗位的工作人数。搞销售的人数真的是不少。难道有不少我大生科的同学吗？？（哈哈哈哈哈哈哈。开个玩笑而已，只是说实话做生物真的非常累啊）。

销售，后期支持，和技术岗人数占领人数排行榜前三。

不同的职业惬意度的分布大体相当。只是accounting的小伙伴们似乎打分都不高哦，其它的几个工种均值和中位数都没有明显区别，接下来我们看看不同职业是否离职的情况和打分的高低情况：

和想象中结果差点儿没有区别，离职和不离职的打分区分度非常高，和职业差点儿没有关系。

那么不同职业的平均工作时长呢，看图而言，没有离职的人群工作时间都非常稳定。可是离职人群的工作时间呈现两极分化的趋势。看来太忙和太闲都不是非常好。这对hr的考验还是非常大的。

后面我们来一次关注一下不同特征和离职的关系问题：

ggplot(hr,aes(x=satisfaction_level,color=left))+geom_line(stat = "density")+ggtitle("惬意度和离职的关系") ggplot(hr,aes(x=salary,fill=left))+geom_histogram(stat="count")+ggtitle("工资和离职的关系") ggplot(hr,aes(x=promotion_last_5years,fill=left))+geom_histogram(stat="count")+ggtitle("近5年升值和离职的关系") ggplot(hr,aes(x=last_evaluation,color=left))+geom_point(stat = "count")+ggtitle("最后一次评价和离职的关系") hr %>% group_by(sales) %>% ggplot(aes(x=sales,fill=Work_accident))+geom_bar()+coord_flip()+  theme(axis.text.x = element_blank(),axis.title.x = element_blank(),axis.title.y = element_blank())+scale_fill_discrete(labels=c("no accident","at least once"))

没有离职的人群打分已知非常稳定，而离职人群的打分就有点难以估摸了

还是那句话。“有钱好办事啊”

你不给宝宝升职，宝宝就生气离职

和前面的面积图几乎相同，hr也要警惕那些最后一次打分非常高的，尽管大部分是不准备离职的。可是有些为了给老东家面子还是会来点“善意的谎言”的。

不出错是不可能的，出错人数多少基本和总人数成正比，所以这个对于离职来说不是问题。

模型构建和评估

index<-sample(2,nrow(hr),replace = T,prob = c(0.7,0.3)) train<-hr[index==1,];test<-hr[index==2,] model<-randomForest(left~.,data = train) predict.hr<-predict(model,test) confusionMatrix(test$left,predict.hr) prob.hr<-predict(model,test,type="prob") roc.hr<-roc(test$left,prob.hr[,2],levels=levels(test$left)) plot(roc.hr,type="S",col="red",main = paste("AUC=",roc.hr$auc,sep = ""))

依据前面的特征分析，本次答主并没有认为有非常好的特征来提取。就直接扔进算法里面计算去了，计算出来的混淆矩阵的情况效果还是杠杠的：

Confusion Matrix and Statistics          Reference Prediction   no  yes       no  3429    5       yes   28 1010                                                         Accuracy : 0.9926                           95% CI : (0.9897, 0.9949)    No Information Rate : 0.773              P-Value [Acc > NIR] : < 2.2e-16                                                                  Kappa : 0.9791           Mcnemar's Test P-Value : 0.0001283                                                            Sensitivity : 0.9919                      Specificity : 0.9951                   Pos Pred Value : 0.9985                   Neg Pred Value : 0.9730                       Prevalence : 0.7730                   Detection Rate : 0.7668             Detection Prevalence : 0.7679                Balanced Accuracy : 0.9935                                                           'Positive' Class : no                                                        

acc=0.9926,recall=0.9951,precision=0.9730,基本都是逆天的数据了，看来kaggle的数据集已经清洗的非常棒了，rf算法也是一如既往地给力。最后贴出ROC曲线的图

写在最后

本次分析事实上并没有非常多的技巧可言，答主的ggplot2水平也遇到了瓶颈期，后期须要不断加强，并且仅仅会调包不懂算法后面的原理更是不能够的，所以近期在慢慢把概率论。线性代数，还是统计学捡起来，当然R语言的数据分析实践还是不会停下来的，答主英语还不错，能够和实验室的老外教授“忽悠”几句。也算是有了不少的进步。

道阻且长，大家共勉~~~

往期回想

词云一分钟了解周董的歌词

R语言实现统计分析——非參数如果检验

《我不是药神》30亿票房后分析徐峥的选角眼光

公众号后台回复keyword就可以学习

回复 爬虫            爬虫三大案例实战  
回复 Python       1小时破冰入门

回复 数据挖掘     R语言入门及数据挖掘
回复 人工智能     三个月入门人工智能
回复 数据分析师  数据分析师成长之路 
回复 机器学习      机器学习的商业应用
回复 数据科学      数据科学实战
回复 经常使用算法      经常使用数据挖掘算法