今日代码(200624)--缺失值处理

代码记录

---

缺失值处理

• 前言

某个比赛中数据的缺失值处理，但是缺的很有规则，填补起来很有逻辑，比较清爽。

• 开始填补

#导包 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)--缺失值处理的全部内容，希望文章能够帮你解决所遇到的问题。

如果觉得生活随笔网站内容还不错，欢迎将生活随笔推荐给好友。