題目：員工離職預測訓練賽
網址：http://www.pkbigdata.com/common/cmpt/員工離職預測訓練賽_競賽資訊.html
要求：
資料主要包括影響員工離職的各種因素（工資、出差、工作環境滿意度、工作投入度、是否加班、是否升職、工資提升比例等）以及員工是否已經離職的對應記錄。
資料分為訓練資料和測試資料，分別儲存在pfm_train.csv和pfm_test.csv兩個檔案中。
其中訓練資料主要包括1100條記錄，31個欄位。
測試資料主要包括350條記錄，30個欄位，跟訓練資料的不同是測試資料並不包括員工是否已經離職的記錄，學員需要通過由訓練資料所建立的模型以及所給的測試資料，得出測試資料相應的員工是否已經離職的預測。
資料：https://pan.baidu.com/s/1qXZOS8W  密碼：bxgm

程式碼：

data <- read.csv("E:/.../員工離職預測訓練賽/資料/pfm_train.csv", sep=",", header=TRUE)
colnames(data)[1]<-c("Age")     #首列列名亂碼
###########################################################################################
##########################      邏輯迴歸      #############################################
###########################################################################################
str(data)

fit.full<-glm(Attrition~.,data=data[,-c(8,18,23)],family=binomial())                       #初步迴歸，AIC: 730.18
summary(fit.full)
step(fit.full)
fit.reduce<-glm(formula = Attrition ~ Age + BusinessTravel + Department +                  #逐步迴歸優化，AIC: 721.3
    DistanceFromHome + EducationField + EnvironmentSatisfaction + 
    Gender + JobInvolvement + JobLevel + JobSatisfaction + MaritalStatus + 
    NumCompaniesWorked + OverTime + RelationshipSatisfaction + 
    TotalWorkingYears + TrainingTimesLastYear + WorkLifeBalance + 
    YearsAtCompany + YearsInCurrentRole + YearsSinceLastPromotion + 
    YearsWithCurrManager, family = binomial(), data = data[, 
    -c(8, 18,23)])
summary(fit.reduce)

test <- predict(fit.full, newdata = data, type = "response")
test1 <- predict(fit.reduce, newdata = data, type = "response")
test[test <0.5] <- 0
test[test >= 0.5] <- 1

result<-cbind(test,data$Attrition)
table(test,data$Attrition)

#未優化          step後
#test   0   1    test   0   1
#   0 902  91       0 898  98
#   1  20  87       1  24  80
#訓練集上看優化前擬合度較高，但提示過擬合

###########################################################################################
##########################      邏輯迴歸+主成分      ######################################
###########################################################################################
data[,2] <- as.factor(as.vector(data)[,2])

#首先將數值型因子進行了標準化，確保所有的因子在一個量綱上，接著對已經標準化的資料進行主成分分析，消除因子中的高相關性
library(caret)
library(ipred)
p_2009 <- preProcess(data[,-c(2,8,18,23)],method=c("scale","center","pca"))           #主成分分析重組各個特徵值
src1_2009_p <- cbind(Attrition=data[,2],predict(p_2009,data[,-c(2,8,18,23)]))

fit.full<-glm(Attrition~.,data=src1_2009_p,family=binomial())                         #AIC: 728.81
summary(fit.full)
step(fit.full)
fit.reduce<-glm(formula = Attrition ~ BusinessTravel + EducationField + Gender +      #716.06
    JobRole + MaritalStatus + OverTime + PC1 + PC4 + PC7 + PC8 + 
    PC9 + PC13 + PC14 + PC15, family = binomial(), data = src1_2009_p)
summary(fit.reduce)

test <- predict(fit.full, newdata = src1_2009_p, type = "response")
test1 <- predict(fit.reduce, newdata = src1_2009_p, type = "response")
test[test <0.5] <- 0
test[test >= 0.5] <- 1
test1[test1 <0.5] <- 0
test1[test1 >= 0.5] <- 1

result<-cbind(test,data$Attrition)
table(test,data$Attrition)

未優化          step後          
test   0   1    test   0   1      0   1 
   0 896  93       0 896  96    922 178 
   1  26  85       1  26  82

#######################  預測  #############################
data1 <- read.csv("E:/.../員工離職預測訓練賽/資料/pfm_test.csv", sep=",", header=TRUE)
colnames(data1)[1]<-c("Age")     #首列列名亂碼

pre_data1 <- predict(p_2009,data1[,-c(7,17,22)])
result <- predict(fit.reduce,pre_data1 ,interval = "prediction", level = 0.95)
result1 <- predict(fit.full,pre_data1 ,interval = "prediction", level = 0.95)

result1 <- result
result1[result1 >= 0.5] <- 1
result1[result1 <0.5] <- 0
table(result1)

file.path <- paste("E:/PACT-上海/私の稿/比賽/員工離職預測訓練賽/out_log.csv",sep="")
write.table(result1,file.path, col.names=T,row.names = F, quote = F, sep=",")