代碼記錄

---

缺失值處理

• 前言

某個比賽中數據的缺失值處理，但是缺的很有規則，填補起來很有邏輯，比較清爽。

• 開始填補

#導包 library(VIM) library(psych) library(lattice) library(mice) library(MASS)#讀取數據 getwd() setwd("C:/Users/goatbishop/Desktop/data") car_srv_train <- read.csv("car_srv_train.csv", header = T, stringsAsFactors = F) car_info_train <- read.csv("car_info_train.csv", header = T, stringsAsFactors = F)#簡單查看數據 head(car_srv_train) head(car_info_train) dim(car_srv_train) dim(car_info_train)#合并數據 intersect(names(car_srv_train), names(car_info_train))new_car <- merge(car_srv_train, car_info_train, "CUST_ID") new_car2 <- merge(car_srv_train, car_info_train, "CUST_ID", all.y = T) #與all = T的合并結果相同dim(new_car) dim(new_car2)#根據觀察，有些客戶沒有回廠，我們把回廠次數以及回廠支出總費用加入到判斷是否會流失的指標中 backFactoryFreq <- table(car_srv_train$CUST_ID) length(backFactoryFreq) backFactoryDf <- as.data.frame(backFactoryFreq) colnames(backFactoryDf) <- c("CUST_ID", "Freq")backFactoryCost <- tapply(car_srv_train$ACTUAL_AMOUNT, car_srv_train$CUST_ID, sum) dim(backFactoryCost) class(backFactoryCost) backFactoryDf2 <- as.data.frame(backFactoryCost) backFactoryDf2$CUST_ID <- row.names(backFactoryDf2)backFactoryDf <- merge(backFactoryDf, backFactoryDf2, "CUST_ID",all = T) dim(backFactoryDf)new_car_info_train <- merge(car_info_train, backFactoryDf, "CUST_ID", all = T)#數據預處理str(new_car_info_train) summary(new_car_info_train) head(new_car_info_train) #性別設為factor(無缺失值) new_car_info_train$CUST_SEX <- factor(new_car_info_train$CUST_SEX) #年齡中有475個缺失值(占比較小，可以考慮全部刪掉，也可考慮填補等等，待定)#婚姻狀況(缺失值較多為39038且已婚人群占所能調查到的大多數，未婚占比非常小) #且最高頻數和次高頻數的比值高達93，考慮刪除該變量 head(new_car_info_train$CUST_MARRY) length(new_car_info_train$CUST_MARRY[which(new_car_info_train$CUST_MARRY == "")]) new_car_info_train$CUST_MARRY[which(new_car_info_train$CUST_MARRY == "")] <- NA new_car_info_train$CUST_MARRY <- factor(new_car_info_train$CUST_MARRY)#車主性質設為factor new_car_info_train$BUYERPART <- factor(new_car_info_train$BUYERPART)#車型代碼設為factor new_car_info_train$CAR_MODEL <- factor(new_car_info_train$CAR_MODEL) table(new_car_info_train$CAR_MODEL)#車型顏色先把""空串設置為NA #有21312個缺失值，好吧 head(new_car_info_train$CAR_COLOR) length(new_car_info_train$CAR_COLOR[which(new_car_info_train$CAR_COLOR == "")]) #21312 new_car_info_train$CAR_COLOR[which(new_car_info_train$CAR_COLOR == "")] <- NA new_car_info_train$CAR_COLOR <- factor(new_car_info_train$CAR_COLOR)#是否貸款買車設為factor new_car_info_train$IS_LOAN <- factor(new_car_info_train$IS_LOAN)#貸款期限存在缺失值，5607 new_car_info_train$LOAN_PERIED <- factor(new_car_info_train$LOAN_PERIED) #我們看到貸款金額的缺失值和貸款期限的缺失值一樣多，都為5607， #所以，是否有由于客戶并沒有貸款，所以沒有填此項的可能 #也就是說是由于變量自身原因，而不是缺失值在樣本中隨機分布的原因 #我們看到IS_LOAD變量值為0的樣品有5607個和缺失值數目一樣，這證明了我們的猜想 #我們對其進行人為填補，設置LOAN_PERIED種類為0，LOAN_AMOUNT金額為0 #https://stackoverflow.com/questions/8229904/r-concatenating-two-factors temp <- as.character(new_car_info_train$LOAN_PERIED) temp[is.na(temp)] <- "0" new_car_info_train$LOAN_PERIED <- factor(temp) new_car_info_train$LOAN_AMOUNT[is.na(new_car_info_train$LOAN_AMOUNT)] <- 0#新車投保是否在4s店設為factor，缺失值為8151 new_car_info_train$F_INSORNOT <- factor(new_car_info_train$F_INSORNOT)#購買4種保險的缺失值一樣多，這可能由于同一個客戶4項都沒有填寫，未填寫原因不明#是否流失設為factor，無缺失值 new_car_info_train$IS_LOST <- factor(new_car_info_train$IS_LOST)#因為未返廠的客戶，4S店沒有記錄，所以對于返廠頻率和總花費的缺失值我們均設置為0 new_car_info_train$Freq[is.na(new_car_info_train$Freq)] <- 0 new_car_info_train$backFactoryCost[is.na(new_car_info_train$backFactoryCost)] <- 0#繪制缺失值圖 aggr(new_car_info_train, prop = F, numbers = T)#通過繪制缺失值圖觀察到，對于購買4項保險缺失的觀測，新車投保是否在4s店變量也存在缺失 #且，新車投保是否在4s店沒有缺失的變量全部都是1，也就是說，一部分缺失的原因，可能是由于 #沒有在4S店投保，因此后面的4項保險也沒有寫 #通過ALL_BUYINS_N變量中，沒有缺失值的部分全都投保，我們可以推測出來 #對于這類我們全部設置其是否在4S店投保為0，4項的次數也都設施為0 #而對于在4S店購買保險總次數>0,或者購買4S店專修險的次數>0的觀測，我們設置 #其是否在4S店投保為1temp <- as.character(new_car_info_train$F_INSORNOT) temp[is.na(new_car_info_train$ALL_BUYINS_N)] <- "0" temp_ALL <- new_car_info_train$ALL_BUYINS_N temp_DLRSI <- new_car_info_train$DLRSI_CNTfor (i in c(1:length(temp))) {if (is.na(temp[i])) {if (temp_ALL[i] > 0 | temp_DLRSI[i] > 0) {temp[i] <- "1"}} }new_car_info_train$F_INSORNOT <- factor(temp) #F_INSORNOT此時無缺失值new_car_info_train$ALL_BUYINS_N[is.na(new_car_info_train$ALL_BUYINS_N)] <- 0 new_car_info_train$DLRSI_CNT[is.na(new_car_info_train$DLRSI_CNT)] <- 0 new_car_info_train$GLASSBUYSEPARATE_CNT[is.na(new_car_info_train$GLASSBUYSEPARATE_CNT)] <- 0 new_car_info_train$SII_CNT[is.na(new_car_info_train$SII_CNT)] <- 0#刪除變量,刪除用戶ID和婚否 new_car_info_train2 <- new_car_info_train[, -c(1, 4)]#繪制缺失值圖 aggr(new_car_info_train2, prop = F, numbers = T)summary(new_car_info_train2) dim(new_car_info_train2) #我們刪除缺失的年齡觀測 new_car_info_train2 <- new_car_info_train2[!is.na(new_car_info_train2$CUST_AGE), ] dim(new_car_info_train2)table(new_car_info_train$IS_LOST) #流失占比0.2293882 table(new_car_info_train2$IS_LOST)#流失占比0.2289921 #基本沒有什么變動，表明刪除的一些年齡觀測對建模沒有顯著影響#對IS_LOST與CAR_COLOR變量進行列聯表檢驗 testDf2 <- new_car_info_train2[!is.na(new_car_info_train2$CAR_COLOR), c("CAR_COLOR", "IS_LOST")] chisq.test(testDf2$CAR_COLOR, testDf2$IS_LOST) table(testDf2) #雖然列聯表檢驗拒絕兩者相互獨立的原假設，但是，這可能是由于顏色因子的水平過多 #從常理上來說顏色和流失沒有太大關系，我們先將其刪除(強行解釋) #之后可以嘗試用加入顏色變量進行建模 new_car_info_train3 <- new_car_info_train2[, -5]#繪制缺失值圖 aggr(new_car_info_train3, prop = F, numbers = T)summary(new_car_info_train3)#目前已經沒有缺失值了##Logistic回歸new_car_info_train3$IS_LOST <- as.character(new_car_info_train3$IS_LOST) table(new_car_info_train3$IS_LOST) new_car_info_train3$IS_LOST <- new_car_info_train3$IS_LOST == 1 #換成TRUE或者FALSE #new_car_info_train3$IS_LOST <- factor(new_car_info_train3$IS_LOST, levels = c(0, 1), labels = c("NO", "Yes"))lm1 <- glm(IS_LOST ~ ., data = new_car_info_train3, family = binomial()) summary(lm1) #45851 #利用AIC準則進行逐步回歸 stepAIC(lm1)#雖然也好像AIC也沒減少多少(45851)，但是，還是利用逐步回歸后的模型 lm2 <- glm(IS_LOST ~ CUST_AGE + BUYERPART + CAR_MODEL + CAR_AGE + CAR_PRICE + LOAN_PERIED + F_INSORNOT + ALL_BUYINS_N + GLASSBUYSEPARATE_CNT + Freq, data = new_car_info_train3, family = binomial())summary(lm2)predCar <- predict(lm2, type = "response") summary(predCar) #我們將數據分為5個等級其中前兩個等級極有可能流失他的概率為80~100%, 50 ~80% #其余3個等級流失危險度逐漸降低為0~10%， 10~30%, 30~50%temp <- predCarfor (i in c(1:length(predCar))) {num = temp[i]if (num > 0.8) {temp[i] <- 5} else if (num <= 0.8 & num > 0.5) {temp[i] <- 4}else if (num <= 0.5 & num > 0.3) {temp[i] <- 3} else if (num <= 0.3 & num > 0.1) {temp[i] <- 2} else {temp[i] <- 1} }table(temp) new_car_info_train3$prob <- factor(temp, levels = c(1, 2, 3, 4, 5), ordered = T) summary(new_car_info_train3) write.csv(new_car_info_train3, "new_car_info_train3_0624.csv")#訓練集正確率計算 temp <- ifelse(predCar > 0.5, 1, 0) table(temp) sum(temp == new_car_info_train3$IS_LOST)/length(temp) #預測正確率78.3%有待改進

• 感想

還不錯吧。

總結

以上是生活随笔為你收集整理的今日代码(200624)--缺失值处理的全部內容，希望文章能夠幫你解決所遇到的問題。

如果覺得生活随笔網站內容還不錯，歡迎將生活随笔推薦給好友。