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