今日代码(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)--缺失值处理相关推荐

今日代码(200708)--缺失值处理
代码记录对经济数据集中的缺失值进行处理前言这个数据集中存在大量的缺失,主要原因是某几个年份的某些指标没找到,或者干脆就是某些指标很难找,导致该指标数据的大批量丢失,更有甚者,由于要查找的年份(2 ...
今日代码(200924)--缺失值处理
缺失值处理对110个城市10年的数据进行缺失值处理. knitr::opts_chunk$set(echo = T, message = FALSE, warning = FALSE) 导包 lib ...
今日代码(20210225)--数据处理
代码记录数据预处理+主成分+熵值法 (R语言) library(VIM) library(mice) library(readr) library(psych) library(fpc) libra ...
今日代码(20210313)--美赛代码记录
代码记录第1及第6题(PageRank+Lasso) my_pagerank <- function(M, r, n, b) {N <- dim(M)[2]r <- r/sum(a ...
今日代码(20201003)--简单爬虫
代码笔记,仅供参考利用python爬取安徽省高校名单因为工作需要,所以我爬取了安徽省高校的名单,并将其保存在csv文件中: # -*- coding: utf-8 -*-# -*- coding: ...
今日代码(200623)--回厂日期预测(python + R)
代码笔记,仅供参考回厂日期预测前言,对不同客户的下一次返厂时间进行预测,大多数客户的返厂次数不足10次,仅有少量客户返厂次数大于30次. 平均值法预测(python) # -*- coding: ...
今日代码(200727)--全局空间自相关性
代码笔记参考自:R语言空间统计分析全局空间自相关性基于k最近邻计算莫兰指数 #####空间计量#########导包####library(spdep) library(sp) library( ...
今日代码(200725)--数据录入(python+mysql)
代码记录数据录入(python+mysql) 前言相比于200612代码增加了一个性别.运动员编号.运动员姓名字段. 代码 # -*- coding: utf-8 -*-import re imp ...
今日代码(200714)--主客观求指标权重及求城市得分
代码记录主客观求指标权重及求城市得分前言有22个指标和71个城市的10年数据,现在利用主成分分析法求出客观权重,并结合主管权重得出总权重,最后利用权重与标准化数值求出10年的得分. 前期准备设 ...

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

缺失值处理

今日代码(200624)--缺失值处理相关推荐

最新文章

热门文章