R语言-离职率分析

案例:员工流失是困扰企业的关键因素之一,在这次的分析中我将分析以下内容:

　　 对一些重要变量进行可视化及探索分析,收入,晋升,满意度,绩效,是否加班等方面进行单变量分析

　　 分析员工流失的因素,探索各个变量的影响度

　　 构建有效的模型来预测员工是否会离职

数据集主要分析的字段

## Attrition 是否离职    需要预测的结果变量
## Gender 性别
## Age 年龄
## Education 学历
## NumCompaniesWorked 任职过的企业数量
## TotalWorkingYears 工作年限
## MaritalStatus 婚姻状况
## YearsAtCompany 在公司的工作时间
## JobRole 职位
## JobLevel 职位等级
## MonthlyIncome 月薪
## JobInvolvement 工作投入程度
## PerformanceRating 绩效评分
## StockOptionLevel 员工的股权等级
## PercentSalaryHike 涨薪百分比
## TrainingTimesLastYear 上一年培训次数
## YearsSinceLastPromotion 距离上次升值的时间
## EnvironmentSatisfaction 环境满意度
## JobSatisfaction 工作满意度
## RelationshipSatisfaction 关系满意度
## WorkLifeBalance 生活和工作的平衡度
## DistanceFromHome 公司和家庭的距离
## OverTime 是否要加班
## BusinessTravel 是否要出差 

1.导入包

library(ggplot2)
library(grid)
library(gridExtra)
library(plyr)
library(rpart)
library(rpart.plot)
library(randomForest)
library(caret)
library(gbm)
library(survival)
library(pROC)
library(DMwR)
library(scales)

2.导入数据集并查看

Attr.df <- read.csv('E:\Udacity\Data Analysis High\R\R_Study\employee.csv',header=T,encoding = 'UTF-8')
head(Attr.df)
summary(Attr.df)

　　结论:离职率大概在1:5左右

　　　　 企业的员工的平均年龄在36,37岁左右

　　　　 月薪的大概是在4900美元,这里采用中位数,平均数会引起偏差

3.单变量分析

　　3.1探索性别,年龄,工龄,企业数量,在公司的时限的分析

# 离职员工年龄的分布
g1 <- ggplot(Attr.df,aes(x=Age,fill=Attrition))+
  geom_density(alpha=0.7)

# 离职员工工作过的企业数量的关系
g2 <- ggplot(Attr.df,aes(x=NumCompaniesWorked,fill=Attrition))+
  geom_density(alpha=0.7)

# 离职员工工龄的分布
g3 <- ggplot(Attr.df,aes(x=YearsAtCompany,fill=Attrition))+
  geom_density(alpha=0.7)

# 离职员工总体工作年限的分布
g4 <- ggplot(Attr.df,aes(x=TotalWorkingYears,fill=Attrition))+
  geom_density(alpha=0.7)
grid.arrange(g1,g2,g3,g4,ncol=2,nrow=2)

　　结论:

　　　　1.年龄较低的员工的离职率较高,主要集中在30岁以下的员工

　　　　2.工作过的企业数量越多越容易离职

　　　　3.在公司工作的时间越久,越不容易离职

　　　　4.工龄低的员工离职的几率比较大

　　3.2性别,职位等级,教育背景,部门的分析

# 离职员工的性别分布
g5 <- ggplot(Attr.df, aes(x= Gender,fill = Attrition)) + 
  geom_bar(position = "fill") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工的职位等级分布
g6 <-ggplot(Attr.df, aes(x= JobLevel,fill = Attrition)) + 
　　geom_bar(position = "fill") + labs(y="Percentage") + 
　　scale_y_continuous(labels=percent) 

# 离职员工的教育背景分布 
g7 <- ggplot(Attr.df, aes(x= Education,fill = Attrition)) + 
　　geom_bar(position = "fill") + labs(y="Percentage") + 
　　scale_y_continuous(labels=percent) 

# 离职员工的部门分布 
g8 <- ggplot(Attr.df, aes(x= Department,fill = Attrition)) + 
　　geom_bar(position = "fill") + labs(y="Percentage") + 
　　scale_y_continuous(labels=percent) grid.arrange(g5, g6, g7, g8, ncol = 2, nrow = 2)

　　结论:

　　　　1.男性的离职率比女性稍高

　　　　2.等级越高离职的可能性越小,但是主要集中1级别的职场新人

　　　　3.学历和离职率没有太大的关联

　　　　4.销售部门相对于其他两个部门离职率较高

　　3.3 探索涨薪比例,培训次数,每年晋升,员工股权的分析

# 离职员工与涨薪比例的关系
g11 <- ggplot(Attr.df, aes(x = PercentSalaryHike, fill = Attrition)) + 
  geom_density(alpha = 0.7)

# 离职员工与培训次数的关系
g12 <- ggplot(Attr.df, aes(x= TrainingTimesLastYear,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工的与每年晋升的关系
g13 <- ggplot(Attr.df, aes(x = YearsSinceLastPromotion, fill = Attrition)) + 
  geom_density(alpha = 0.7)

# 离职员工与股票期权的关系
g14 <- ggplot(Attr.df, aes(x= StockOptionLevel,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

grid.arrange(g11, g12, g13, g14, ncol = 2)

　　　　结论:

　　　　　　1.没有涨薪计划的员工流失率较高

　　　　　　2.培训次数和离职率没有太大的影响

　　　　　　3.没有晋升的员工离职率较高

　　　　　　4.没有股权的员工流失率较大

　　3.4探索工作满意度,同事满意度,环境满意度的分析

# 离职员工与工作满意度的关系
g15 <- ggplot(Attr.df, aes(x= JobSatisfaction,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工与同事满意度的关系
g16 <- ggplot(Attr.df, aes(x= RelationshipSatisfaction,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工与工作环境满意度的关系
g17 <- ggplot(Attr.df, aes(x= EnvironmentSatisfaction,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 
grid.arrange(g15, g16,g17, ncol = 3)

　　结论:满意度越高越不容易离职

　　3.5探索加班,工作生活的平衡性,是否需要出差,家庭距离之间的关系

# 离职员工和加班之间的关系
g18 <- ggplot(Attr.df, aes(x= OverTime,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工和工作生活之间的关系
g19 <- ggplot(Attr.df, aes(x= WorkLifeBalance,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工和出差之间的关系
g20 <- ggplot(Attr.df, aes(x= BusinessTravel,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

# 离职员工和上班距离之间的关系
g21 <- ggplot(Attr.df,aes(x=DistanceFromHome,fill=Attrition))+
  geom_density(alpha=0.7)

grid.arrange(g18, g19,g20,g21, ncol = 2)

　　结论:

　　　　1.加班越多离职率越高

　　　　2.认为工作和生活协调为1的员工工离职率较高

　　　　3.经常出差的员工离职率较高

　　　　4.距离上班地点越远的员工离职率较高

　　3.6月薪,职位等级和离职率的关系

# 离职员工和月薪的关系
g9 <- ggplot(Attr.df,aes(x=MonthlyIncome,fill=Attrition))+
  geom_density(alpha=0.7)

# 离职员工与职位等级的关系
g10 <- ggplot(Attr.df, aes(x= JobInvolvement,  group=Attrition)) + 
  geom_bar(aes(y = ..prop.., fill = Attrition), 
           stat="count", alpha = 0.7,position = "identity",color="black") +
  labs(y="Percentage") + scale_y_continuous(labels=percent) 

grid.arrange(g9, g10, ncol = 2)

　　结论:

　　　　1.月薪低的员工容易离职

　　　　2.职位级别低的离职率较高,但不是很明显

　　3.6进一步分析月薪和职位级别的关系

ggplot(Attr.df,aes(x=JobInvolvement,y=MonthlyIncome,group=JobInvolvement))+
  geom_boxplot(aes(fill=factor(..x..)),alpha=0.7)+
  theme(legend.position = 'none',plot.title = element_text(hjust = 0.5))+
  facet_grid(~Attrition)+ggtitle('Attrition')

　　结论:可以明显的得出收入的高低并不是影响员工离职的最主要的因素,如果付出和回报不成正比,会有极大的员工流动

4.建模

　　4.1决策树

# 去除数据集中没有必要的因子
levels(Attr.df$JobRole) <- c("HC", "HR", "Lab", "Man", "MDir", "RsD", "RsSci", "SlEx", "SlRep")
levels(Attr.df$EducationField) <- c("HR", "LS", "MRK", "MED", "NA", "TD")
Attr.df <- Attr.df[c(-9,-10,-22,-27)]
# 把数据集划分成训练集和测试集
n <- nrow(Attr.df)
rnd <- sample(n,n*0.7)
train <- Attr.df[rnd,]
test <- Attr.df[-rnd,]
# 建模
dtree <- rpart(Attrition~.,data=train)
preds <- predict(dtree,test,type='class')
rocv <- roc(as.numeric(test$Attrition),as.numeric(preds))
rocv$auc
prop.table(table(test$Attrition,preds,dnn = c('Actual','Predicted')),1)
dtreepr <- prune(dtree,cp=0.01666667)
predspr <- predict(dtreepr,test,type='class')
rocvpr <- roc(as.numeric(test$Attrition),as.numeric(predspr))
rocvpr$auc
rpart.plot(dtreepr,type=4,extra=104,tweak = 0.9,fallen.leaves = F,cex = 0.7)

　　结论:AUC的值0.624比较低,而且灵敏度0.3说明该模型并不能很好的预测离职

　　4.2随机森林

set.seed(2343)
fit.forest <- randomForest(Attrition~.,data=train)
rfpreds <- predict(fit.forest,test,type='class')
rocrf <- roc(as.numeric(test$Attrition),as.numeric(rfpreds))
rocrf$auc

　　结论:需要进行优化

　　4.3GBM

set.seed(3443)
# 定义10折交叉验证用于控制所有的GBM模型训练
ctrl <- trainControl(method = 'cv',number=10,summaryFunction = twoClassSummary,classProbs = T)
gbmfit <- train(Attrition~.,data=train,method='gbm',verbose=F,metric='ROC',trControl=ctrl)
gbmpreds <- predict(gbmfit,test)
rocgbm <- roc(as.numeric(test$Attrition),as.numeric(gbmpreds))
rocgbm$auc

　　结论:需要进行优化

　4.4优化GBM模型

# 设置和之前一样的种子数
ctrl$seeds <- gbmfit$control$seeds

# 加权GBM,设置权重参数,平衡样本
model_weights <- ifelse(train$Attrition == 'No',
                        (1/table(train$Attrition)[1]),
                        (1/table(train$Attrition)[2]))
                        
    
weightedleft <- train(Attrition ~ .,
                      data=train,
                      method='gbm',
                      verbose=F,
                      weights=model_weights,
                      metric='ROC',
                      trControl=ctrl)

weightedpreds <- predict(weightedleft,test)
rocweight <- roc(as.numeric(test$Attrition),as.numeric(weightedpreds))
rocweight$auc

# 向上采样
ctrl$sampling <- 'up'
set.seed(3433)
upfit <- train(Attrition ~., 
               data = train, 
               method = "gbm", 
               verbose = FALSE, 
               metric = "ROC", 
               trControl = ctrl)

uppreds <- predict(upfit, test)
rocup <- roc(as.numeric(test$Attrition), as.numeric(uppreds))
rocup$auc

# 向下采样
ctrl$sampling <- 'down'
set.seed(3433)
downfit <- train(Attrition ~., 
               data = train, 
               method = "gbm", 
               verbose = FALSE, 
               metric = "ROC", 
               trControl = ctrl)

downpreds <- predict(downfit, test)
rocdown <- roc(as.numeric(test$Attrition), as.numeric(downpreds))
rocdown$auc

prop.table(table(test$Attrition, weightedpreds, dnn = c("Actual", "Predicted")),1)

　　结论:选取第二车向上采样的模型,精确度提升到72%,灵敏度提升到62%

5 使用模型来预测离职

　　5.1查看哪些因素影响员工离职

varImp(upfit)

　　结论:影响员工离职的首要因素:加班,月薪,在公司工作的年限,是否有股权,年龄等因素

　　5.2预测工作投入高,月薪少的员工的离职率

upfitprobs <- predict(upfit,test,type = 'prob')
test$Prediction <- upfitprobs$Yes
ggplot(test,
       aes(x=MonthlyIncome,y=Prediction,color=factor(JobInvolvement)))+
  geom_point(alpha=0.7)+
  geom_smooth(method = 'lm')+
  facet_wrap(~JobInvolvement)+
  theme(legend.position = 'none')+
  ggtitle('JobInvolvement')+
  theme(plot.title = element_text(hjust = 0.5))

　　结论:图4表示工作投入高,但是月薪低的员工反而是不容易离职的,可能是因为对企业有归属感或者是企业的其他福利待遇较好

　　5.3预测那些职位的离职率最高

ggplot(test,aes(x=JobRole,y=Prediction,fill=JobRole))+
  geom_boxplot(alpha=0.5)+
  theme(legend.position = 'none')+
  scale_y_continuous(labels = percent)

　　结论:销售的离职率相对与其他的离职率较大

总结:

　　1.员工离职的很大原因是因为加班,或者是付出和回报不成正比导致的

　　2.在某些生活方面,比如频繁出差,上班路程较远也是员工离职的一个次要原因

　　3.相比于高薪的吸引力,员工更加认可股权的享有,享有股权分红的员工更不容易离职

　　4.年龄,在公司的年限和工龄也是影响员工离职的一些重要的指标

　　5.如果有更多的真实数据集,模型可能会更加准确

github:https://github.com/Mounment/R-Project