chapter 6

P2P信用贷款风险控制（用户逾期还款概率模型）

关于数据库的应用+数据清洗+实时数据识别>>探索性分析+寻找关键因素>>建立GBM（梯度提升机）模型+ROC评价模型+参数自动调节

6.2 任务实

对数据进行初步探索，确定关键因素，所以本章节更多的是关于数据格式和数据清洗的一个训练
分析用户信息完善程度与逾期率的关系

# 设置工作目录
setwd()
df.tr.master <- read.csv("./data/Training_Master.csv")  # 读取训练集
df.ts.master <- read.csv("./data/Test_Master.csv")  # 读取测试集df.ts.master["target"] <- NA  # 测试集没有target，添加一列，并用NA赋值，方便后续合表
df.tr.master[df.tr.master == "不详"] <- NA
df.ts.master[df.ts.master == "不详"] <- NA
df.master <- rbind(df.tr.master, df.ts.master)df.master[, "na.num"] <- apply(is.na(df.master), 1, sum)  # 缺失值个数# 绘制用户信息完整度和逾期率的关系图
# 绘制主表中用户信息缺失的情况，以缺失个数为纵坐标
plot(df.master[order(df.master[, "na.num"]), "na.num"],ylab = "用户缺失信息的个数")
lines(x = c(0:50000), y = rep(2, 50001), type = "l", col = "red", lwd = 2)
lines(x = c(0:50000), y = rep(10, 50001), type = "l", col = "red", lwd = 2)
# 剔除离群点，离群点样本数较少，存在偶然性
rid.out <- which((df.master[, "na.num"] <= 10 & df.master[, "na.num"] >= 2))
rid.out.tg <- df.master[rid.out, "target"]
na.num.fre <- table(rid.out.tg, df.master[rid.out, "na.num"])
tg.fre <- na.num.fre[2,] / (na.num.fre[1,] + na.num.fre[2,])  # 计算逾期率
row.names(na.num.fre)
barplot(tg.fre)
group <- c()
for (i in 1:7) {if (i %% 3 == 1) {tg.fre.group <- tg.fre[i] + tg.fre[i + 1] + tg.fre[i + 2]group <- c(group, tg.fre.group)}
}
# 分组
barplot(group, xaxt = "n", ylab = "逾期率", xlab = "用户信息缺失的个数", ylim = c(0, 0.25))
text.group <- c("2-4", "5-7", "8-10")
axis(1, at = c(0.7, 1.9, 3.1), labels = text.group, tick = FALSE)

分析用户信息修改情况与逾期率关系

# 分布分析
df.tr.update <- read.csv("./data/Training_Userupdate.csv")  # 读取训练集
df.ts.update <- read.csv("./data/Test_Userupdate.csv")  # 读取测试集
df.update <- rbind(df.tr.update, df.ts.update)  # 合并update数据# 计算用户更新信息的天数
df.update.num <- table(unique(df.update[c("Idx", "UserupdateInfo2")])$Idx)
df.update.num <- data.frame(df.update.num)
colnames(df.update.num) <- c("Idx", "update.num")# 绘制用户修改信息天数与逾期率的关系图
# 绘制更新信息表中用户修改信息的情况，以修改的天数为纵坐标
plot(df.update.num[order(df.update.num[, "update.num"]), "update.num"],ylab = "用户修改信息的天数")
lines(x = c(0:50000), y = rep(5, 50001), type = "l", col = "red", lwd = 2)
rid.out <- which(df.update.num[, "update.num"] <= 5)  # 剔除离群点
update.num <- merge(df.master, df.update.num, by = "Idx")
rid.out.tg <- update.num[rid.out, "target"]
update.num <- table(rid.out.tg, df.update.num[rid.out, "update.num"])
update.num <- update.num[2, ] / (update.num[1,] + update.num[2, ])  # 计算逾期率
barplot(update.num, ylim = c(0, 0.12), xlab = "修改信息的天数", ylab = "逾期率")

分析用户所在区域经济发展状况与逾期率关系

# 省GDP
df.gdp.prov <- read.csv("./data/Province_GDP.csv")
library(stringr)
# 去除省或市后面的空格
df.gdp.prov[, "province"] <- str_replace_all(df.gdp.prov[, "province"], " ", "")
# 将省字去掉
df.gdp.prov[, "province"] <- str_replace_all(df.gdp.prov[, "province"], "省", "")
# 将市字去掉
df.gdp.prov[, "province"] <- str_replace_all(df.gdp.prov[, "province"], "市", "")
df.gdp.prov <- df.gdp.prov[, c("province", "provGDPpp")]
prov <- c("UserInfo_7", "UserInfo_19")
# 去掉省字
for (i in (1:length(prov))) {df.master[, prov[i]] <- str_replace_all(df.master[, prov[i]], "省", "")
}
# 将省人均GDP加入主表中
df.master <- merge(df.master, df.gdp.prov, by.x = "UserInfo_7", by.y = "province", all = TRUE, sort = FALSE)# 绘制各省逾期情况图
gdp.tg <- data.frame(df.master$target, df.master$UserInfo_7, df.master$provGDPpp)
gdp.tg <- gdp.tg[order(gdp.tg[, 3], decreasing = FALSE),]
colnames(gdp.tg) <- c("target", "province", "provGDPpp")
gdp.fre <- table(gdp.tg$target, gdp.tg$provGDPpp)
gdp.fre <- gdp.fre[2,] / (gdp.fre[1,] + gdp.fre[2,])
barplot(gdp.fre, xaxt = "n", ylim = c(0, 0.12), ylab = "逾期率")
text.x = c("甘肃", "贵州", "云南", "西藏", "广西", "安徽", "江西", "山西","四川", "河南", "海南", "黑龙江", "青海", "河北", "湖南","新疆", "宁夏", "陕西", "湖北", "重庆", "吉林", "山东", "福建","广东", "辽宁", "内蒙古", "浙江", "江苏", "上海", "北京", "天津")
num.x = seq(0.8, 36.963, 1.193)
axis(1, at = num.x, labels = text.x, las = 2, tick = FALSE)
par(new = T)
gdp.order <- df.gdp.prov[order(df.gdp.prov[, 2]),]
plot(gdp.order[, 2], ann = FALSE, type = "l", lwd = 2, col = "red", axes = FALSE, sub = "省人均GDP")
gdp = seq(0, 120000, 30000)
axis(4, at = gdp, labels = gdp, col = "red", lwd = 2)
legend(2, 105000, lty = c(1, NA), pch = c(NA, 15), lwd = c(2, 1),col = c("red", "gray"), legend = c("省人均GDP", "各省逾期率"))

分析用户借款月份与逾期率关系

# 获取借款成交的月份
df.master[, "listing.month"] <- as.numeric(format(as.Date(df.master$ListingInfo, format = "%Y/%m/%d"), "%m"))
df.master$ListingInfo <- NULL
write.csv(df.master, "./tmp/df_master.csv", row.names = FALSE)  # 写出数据# 绘制用户借款月份和逾期率的关系图
mon.fre <- table(df.master$target, df.master$listing.month)
mon.fre <- mon.fre[2, ] / (mon.fre[1, ] + mon.fre[2, ])
barplot(mon.fre, xlab = "用户借款月份", ylab = "逾期率")

分析用户信息完善程度与逾期率关系

# 设置工作目录
setwd()
df.tr.master <- read.csv("./data/Training_Master.csv")  # 读取训练集
df.ts.master <- read.csv("./data/Test_Master.csv")  # 读取测试集df.ts.master["target"] <- NA  # 测试集没有target，添加一列，并用NA赋值，方便后续合表
df.tr.master[df.tr.master == "不详"] <- NA
df.ts.master[df.ts.master == "不详"] <- NA
df.master <- rbind(df.tr.master, df.ts.master)df.master[, "na.num"] <- apply(is.na(df.master), 1, sum)  # 缺失值个数# 绘制用户信息完整度和逾期率的关系图
# 绘制主表中用户信息缺失的情况，以缺失个数为纵坐标
plot(df.master[order(df.master[, "na.num"]), "na.num"],ylab = "用户缺失信息的个数")
lines(x = c(0:50000), y = rep(2, 50001), type = "l", col = "red", lwd = 2)
lines(x = c(0:50000), y = rep(10, 50001), type = "l", col = "red", lwd = 2)
# 剔除离群点，离群点样本数较少，存在偶然性
rid.out <- which((df.master[, "na.num"] <= 10 & df.master[, "na.num"] >= 2))
rid.out.tg <- df.master[rid.out, "target"]
na.num.fre <- table(rid.out.tg, df.master[rid.out, "na.num"])
tg.fre <- na.num.fre[2,] / (na.num.fre[1,] + na.num.fre[2,])  # 计算逾期率
row.names(na.num.fre)
barplot(tg.fre)
group <- c()
for (i in 1:7) {if (i %% 3 == 1) {tg.fre.group <- tg.fre[i] + tg.fre[i + 1] + tg.fre[i + 2]group <- c(group, tg.fre.group)}
}
# 分组
barplot(group, xaxt = "n", ylab = "逾期率", xlab = "用户信息缺失的个数", ylim = c(0, 0.25))
text.group <- c("2-4", "5-7", "8-10")
axis(1, at = c(0.7, 1.9, 3.1), labels = text.group, tick = FALSE)

（对P2P数据进行预处理）
使用第三方平台信息构建新特征

# 设置工作目录
setwd()
library(stringr)
# 代码 6-5
df.master <- read.csv("./tmp/df_master.csv", stringsAsFactors = FALSE)
library(stringr)
# 第三方信息处理
colnames(df.master)
third.Info1 <- df.master[, 91:209]  # 提取第三方数据
third.Info_var <- apply(third.Info1, 2, var)  # 按列求方差
# 按降序排序
third.Info_var1 <- third.Info_var[order((third.Info_var), decreasing = TRUE)]
barplot(third.Info_var1[1:20], las = 2, col = rainbow(20), width = 3, legend.text = FALSE)  # 绘制方差前20的柱状图
third.info <- matrix(nrow = 17, ncol = 7)
for (i in (1:17)) {for (j in (1:7)) {third.info[i, j] <- paste("ThirdParty_Info_Period", j, "_", i, sep = "")}
}
# 对ThirdParty_Infoi_j分别进行简单统计，如求最大值，最小值中位数和标准差
for (i in (1:17)) {colns <- paste("ThirdParty_Info_", i, "_max", sep = "")df.master[, colns] <- apply(df.master[, third.info[i, ]], 1, max)
}for (i in (1:17)) {colns <- paste("ThirdParty_Info_", i, "_min", sep = "")df.master[, colns] <- apply(df.master[, third.info[i, ]], 1, min)
}
for (i in (1:17)) {colns <- paste("ThirdParty_Info_", i, "_median", sep = "")df.master[, colns] <- apply(df.master[, third.info[i, ]], 1, median)
}
for (i in (1:17)) {colns <- paste("ThirdParty_Info_", i, "_sd", sep = "")df.master[, colns] <- apply(df.master[, third.info[i, ]], 1, sd)
}for (i in (1:7)) {colns <- paste("ThirdParty_Info_period", i, "_max", sep = "")df.master[, colns] <- apply(df.master[, third.info[, i]], 1, max)
}
for (i in (1:7)) {colns <- paste("ThirdParty_Info_period", i, "_min", sep = "")df.master[, colns] <- apply(df.master[, third.info[, i]], 1, min)
}
for (i in (1:7)) {colns <- paste("ThirdParty_Info_period", i, "_median", sep = "")df.master[, colns] <- apply(df.master[, third.info[, i]], 1, median)
}
for (i in (1:7)) {colns <- paste("ThirdParty_Info_period", i, "_sd", sep = "")df.master[, colns] <- apply(df.master[, third.info[, i]], 1, sd)
}
write.csv(df.master, "./tmp/df_master_clear.csv", row.names = FALSE)  # 写出数据

对登陆信息表与更新信息表进行长宽表转换

# 读取数据
df.tr.update <- read.csv("./data/Training_Userupdate.csv")
df.ts.update <- read.csv("./data/Test_Userupdate.csv")
df.tr.log <- read.csv("./data/Training_LogInfo.csv")
df.ts.log <- read.csv("./data/Test_LogInfo.csv")
# 合并数据
df.update <- rbind(df.tr.update, df.ts.update)
df.log <- rbind(df.tr.log, df.ts.log)# 求出最早修改日期，最晚修改日期和放款日期之差。
# 将字段变成日期形式
df.log1 <- data.frame(df.log[, 1], as.Date(df.log[, 2]), as.Date(df.log[, 5]))
df.log1 <- unique(df.log1)  # 去掉重复字段
# 求出借款成交时间和登录时间的时间差
df.log2 <- data.frame(df.log1[, 1], df.log1[, 2] - df.log1[, 3])
colnames(df.log2) <- c("Idx", "date.diff")  # 对字段进行重命名，方便后期合表
df.fir.log <- aggregate(df.log2[, 2], list(df.log2[, 1]), max)  # 最早修改时间
colnames(df.fir.log) <- c("Idx", "first.log")  # 对字段进行重命名，方便后期合表
df.fir.log[, "first.log"] <- sapply(df.fir.log[, "first.log"], as.numeric)
df.last.log <- aggregate(df.log2[, 2], list(df.log2[, 1]), min)  # 最晚修改时间
colnames(df.last.log) <- c("Idx", "last.log")  # 对字段进行重命名，方便后期合表
df.last.log[, "last.log"] <- sapply(df.last.log[, "last.log"], as.numeric)
# 将操作类型和操作代码，以“,”分隔，保存在新增的log.full列
df.log[, "log.full"] <- as.data.frame(paste(df.log[, 3], df.log[, 4], sep = ","))# 计算用户总的登录类型数目
df.log.cats <- as.data.frame(table(unique(df.log[, c(1, 6)])["Idx"]))
colnames(df.log.cats) <- c("Idx", "log.cats")  # 对表中字段进行重命名# 对每种登录类型按Idx计数
df.log.type <- as.data.frame.matrix(xtabs( ~ Idx + log.full, df.log, sparse = TRUE))
df.log.type[, "Idx"] <- rownames(df.log.type)  # 增加Idx字段，方便后续合表# 计算用户第一次登录之后的每一天登录平台的频率
df.log.1tab <- as.data.frame(table(df.log[, 1]))
df.log.fre <- data.frame(df.log.1tab[, 1], df.log.1tab[, 2] / as.data.frame(as.numeric(df.fir.log[, 2]) + 1))
colnames(df.log.fre) <- c("Idx", "log.frequency")# 计算用户登录平台的天数
df.log.num <- table(unique(df.log[c("Idx", "LogInfo3")])$Idx)
df.log.num <- data.frame(df.log.num)
colnames(df.log.num) <- c("Idx", "lognum")# 根据Idx字段合并表格
df.log.final <- merge(df.fir.log, df.last.log, by = "Idx")
df.log.final <- merge(df.log.final, df.log.cats, by = "Idx")
df.log.final <- merge(df.log.final, df.log.fre, by = "Idx")
df.log.final <- merge(df.log.final, df.log.type, by = "Idx")
df.log.final <- merge(df.log.final, df.log.num, by = "Idx")
write.csv(df.log.final, "./tmp/df_log_final.csv", row.names = FALSE)  # 写出数据# Process UserUpdate
# 字符转换
# 将update数据框中的‘_’替换成为""
df.update[, 3] <- str_replace_all(df.update[, 3], "[_]", "")
df.update[, 3] <- str_to_lower(df.update[, 3])  # 将所有字母变成小写# 对每种修改的特征按Idx计数
df.update1 <- as.data.frame.matrix(xtabs( ~ Idx + UserupdateInfo1, df.update, sparse = TRUE))
# 计算平均每个特征用户会修改的频率
df.update1[, "updatecompl"] <- apply(df.update1, 1, sum) / length(df.update1)
Idx <- rownames(df.update1)
df.update1 <- data.frame(Idx, df.update1)  # 增加Idx字段，方便后续合表df.update2 <- data.frame(df.update[, 1], as.Date(df.update[, 2]), as.Date(df.update[, 4]))  # 将字段变成日期形式
df.update2 <- unique(df.update2)
# 求出时间差
df.update3 <- data.frame(df.update2[, 1], df.update2[, 2] - df.update2[, 3])
colnames(df.update3) <- c("Idx", "date.diff")  # 对表中字段进行重命名
# 最早修改时间
df.fir.update <- aggregate(df.update3[, 2], list(df.update3[, 1]), max)
colnames(df.fir.update) <- c("Idx", "first.update")  # 对表中字段进行重命名
df.fir.update[, "first.update"] <- sapply(df.fir.update[, "first.update"], as.numeric)
# 最晚修改时间
df.last.update <- aggregate(df.update3[, 2], list(df.update3[, 1]), min)
colnames(df.last.update) <- c("Idx", "last.update")  # 对表中字段进行重命名
df.last.update[, "last.update"] <- sapply(df.last.update[, "last.update"], as.numeric)
# 计算用户更改特征数目
df.update.cats <- as.data.frame(table(unique(df.update[, c(1, 3)])["Idx"]))
colnames(df.update.cats) <- c("Idx", "update.cats")  # 对表中字段进行重命名# 计算用户第一次更新信息之后的每一天更新信息的频率
df.update.1tab <- as.data.frame(table(df.update1[, 1]))
df.update.fre <- data.frame(df.update.1tab[, 1], df.update.1tab[, 2] / as.data.frame(as.numeric(df.fir.update[, 2]) + 1))
colnames(df.update.fre) <- c("Idx", "update.frequency")# 计算用户更新信息的天数
df.update.num <- table(unique(df.update[c("Idx", "UserupdateInfo2")])$Idx)
df.update.num <- data.frame(df.update.num)
colnames(df.update.num) <- c("Idx", "update.num")# 合并数据框
df.update.final <- merge(df.fir.update, df.last.update, by = "Idx")
df.update.final <- merge(df.update.final, df.update.cats, by = "Idx")
df.update.final <- merge(df.update.final, df.update.fre, by = "Idx")
df.update.final <- merge(df.update.final, df.update1, by = "Idx")
df.update.final <- merge(df.update.final, df.update.num, by = "Idx")
write.csv(df.update.final, "./tmp/df_update_final.csv", row.names = FALSE)

转换与清洗P2P信贷数据

# 第一部分：针对类别型特征的处理
df.master <- read.csv("./tmp/df_master_clear.csv", stringsAsFactors = TRUE)# 将列UserInfo_9的空格符去掉
df.master[, "UserInfo_9"] <- str_replace_all(df.master[, "UserInfo_9"], " ", "")
df.master[, "UserInfo_9"] <- as.factor(df.master[, "UserInfo_9"]) # 字符转换为因子
# 省份是否相同,相同为1，不同为0
df.master[, "diffprov"] <- as.integer(df.master["UserInfo_7"] == df.master["UserInfo_19"])
# 当diffprov列为NA时，为-1
df.master[is.na(df.master["diffprov"]), "diffprov"] <- as.integer(-1)
# 字符处理
city <- c("UserInfo_2", "UserInfo_4", "UserInfo_8", "UserInfo_20")
for (i in (1:length(city))) {# 去掉市字df.master[, city[i]] <- str_replace_all(df.master[, city[i]], "市", "")
}# 市是否相同
diff.cols <- c()
for (i in (1:(length(city) - 1))) {for (j in (length(city):(i + 1))) {tmp <- paste("UserInfodiff_", strsplit(city[i], "_")[[1]][2], "_", strsplit(city[j], "_")[[1]][2], sep = "")# 用UserInfodiff_1_2表示第1列和第2列的城市是否相同diff.cols <- c(diff.cols, tmp)  df.master[, tmp] = as.integer(df.master[, city[i]] == df.master[, city[j]])}
}
# 为空则赋值-1
df.master[, diff.cols][is.na(df.master[, diff.cols])] <- as.integer(-1)
prov <- c("UserInfo_7", "UserInfo_19")
# 用prov_i代替省名
for (i in (1:length(prov))) {df.master[, prov[i]] <- as.factor(df.master[, prov[i]])df.master[, prov[i]] <- as.integer(df.master[, prov[i]])df.master[, prov[i]] <- paste("prov", df.master[, prov[i]], sep = "_")df.master[, prov[i]] <- as.factor(df.master[, prov[i]])
}
# 用city_i代替市名
for (i in (1:length(city))) {df.master[, city[i]] <- as.factor(df.master[, city[i]])df.master[, city[i]] <- as.integer(df.master[, city[i]])df.master[, city[i]] <- paste("city", df.master[, city[i]], sep = "_")df.master[, city[i]] <- as.factor(df.master[, city[i]])
}
# 数据转换
# factor型特征
# 哑变量化函数
DummyFact <- function(x, a = 0.002) {# x为各特征的名称# a为默认值，指样本占总样本的百分比为0.002x <- as.character(x)tmp <- table(x) / length(x)  # 样本占总样本的百分比# 小数量样本占总数比率超过a，则合并为otherif (sum(tmp[tmp < a]) > a) {tmp1 <- tmp[tmp < a]rowlist <- rep(F, length(x))for (i in (1:length(tmp1))) {rowlist <- (rowlist | (names(tmp1[i]) == x))}x[rowlist] <- "other"}# 缺失值占总数比率大于a，则为unknownrowlist <- is.na(x) | is.infinite(x)if (1 - sum(tmp) >= a) {x[rowlist] <- "unknow"}else {# 小于a，则不归为一类，赋值为众数x[rowlist] <- names(tmp[tmp == max(tmp)])}x <- as.factor(x)
}# 哑变量化
library(caret)
isf <- as.logical(lapply(df.master[1, ], is.factor))
df.master.f <- df.master[, isf]
df.master.nf <- df.master[, !isf]
df.master.f <- apply(df.master.f, 2, DummyFact)
mainEffects <- dummyVars(~., data = df.master.f, sep = "_")
df.master.f <- predict(mainEffects, df.master.f)
df.master <- cbind(df.master.nf, df.master.f)

第二部分：数值型数据的缺失值处理

df.update.final <- read.csv("./tmp/df_update_final.csv", stringsAsFactors = FALSE)
df.log.final <- read.csv("./tmp/df_log_final.csv", stringsAsFactors = FALSE)
# 缺失值统计
MissSum <- function(x) {a <- sum(is.na(x))  # x:向量return(a)
}
miss.sum.num <- sapply(df.master, MissSum)  # 统计各列缺失值个数
miss.rate <- miss.sum.num / length(df.master[, 1])
# 绘制特征缺失比率图
barplot(miss.rate[order(miss.rate, decreasing = TRUE)[1:5]], ylim = c(0, 1),main = "特征缺失比率图", xlab = "特征名称", ylab = "缺失比率")
df.master <- df.master[miss.rate < 0.965]  # 将缺失值大于0.965的列剔除# 多重共线性处理，先处理缺失值，数值型缺失值填充为中位数
library(Hmisc)
num.miss.col <- sapply(df.master, anyNA)
num.miss.col <- as.data.frame(num.miss.col[num.miss.col == TRUE])
num.miss.col <- setdiff(row.names(num.miss.col), "target")
df.master[num.miss.col] <- impute(df.master[num.miss.col], median)  # 插补中位数

第三部分：筛选冗余特征


inval.cols <- c("Idx", "target")
line.cols <- names(df.master)
line.cols <- setdiff(line.cols, inval.cols)
df.master[, line.cols][is.na(df.master[, line.cols])] <- as.integer(-1)
df.cor <- cor(df.master[,line.cols])
df.len <- length(df.cor[1, ])
cor.col <- c(1:df.len)
# 将相关系数大于0.99的列剔除
for (i in (1:(df.len - 1))) {for (j in c((i + 1):df.len)) {if (!is.na(df.cor[i, j])) {if (abs(df.cor[i, j]) > 0.99) {tmp <- which(cor.col == j)if (length(tmp) > 0) {cor.col <- cor.col[-tmp]}}}}
}
df.master <- df.master[c("Idx", line.cols[cor.col], "target")]
# 合并数据
df.final <- merge(df.update.final, df.log.final, by = "Idx", all = TRUE)
df.final <- merge(df.final, df.master, by = "Idx", all = TRUE)# log和update两张表数据缺失值填充为0
inval.cols <- c("Idx", "target")
log.up.col <- c(colnames(df.update.final)[-1], colnames(df.log.final)[-1])
mat <- is.na(df.final[, log.up.col])
int0 <- as.integer(0)
for (i in (1:length(mat[1, ]))) {df.final[mat[, i], log.up.col[i]] = int0
}# 同一值去字段
SmVal <- function(x) {# x:vectorvaltlb <- table(x) / length(x)if (sum(valtlb[valtlb > 0.99]) != 0)return(F)elsereturn(T)
}
cols <- apply(df.final, 2, SmVal)
df.final <- df.final[, cols]# 变异系数去字段
Csd <- function(x) {# x:vectora <- sd(x, na.rm = TRUE) / mean(x, na.rm = TRUE)return(a)
}
cols <- sapply(df.final, is.numeric)
cols[inval.cols] <- F
# 求出数值型字段标准差，要求不包含缺失值
cov.num.cols <- lapply(df.final[cols], Csd)
df.final <- df.final[cov.num.cols >= 0.1]  # 剔除变异系数小于0.1的字段
write.csv(df.final, "./tmp/df_final.csv", row.names = FALSE)

（建模部分）
关于GBM(gradient boosting machine)梯度提升机（分类、回归、排序问题）：这是一种提高模型精度的建模方法，原理与Boosting相似，但是其对于正确和错误样本的加权与Boosting不同。GBM在梯度方向上建立新的模型，因为是以残差减少作为梯度提升的方向，所以新模型的建立都是为了减少残差而存在的。关于模型的评价可以用ROC曲线评定，TPR/FPR。
优点：鲁棒性强（适用能力强）、相对少参数时可以有较好的预测效果，和SVM一样是泛化能力较强的算法
缺点：弱学习器之间存在依赖关系，难以并行训练数据，调参与训练时间长

# 设置工作目录并读取数据
setwd()
df.final <- read.csv("./tmp/df_final.csv", stringsAsFactors = FALSE)# 建模
# 对预处理后的数据分训练集和测试集
line.cols <- names(df.final)
line.cols <- setdiff(line.cols, "Idx")
train.data <- df.final[ ! is.na(df.final$target), line.cols]
test.data <- df.final[is.na(df.final$target), line.cols]
test.idx <- df.final[is.na(df.final$target), "Idx"]
test.idx <- data.frame(Idx = test.idx)
test.data[, "target"] <- NULL
library(gbm)
library(pROC)
gbm.model <- gbm(target ~ ., data = train.data, distribution = "adaboost", n.trees = 1500, shrinkage = 0.01, interaction.depth = 4, bag.fraction = 0.5, train.fraction = 0.5, n.minobsinnode = 10, cv.folds = 3, keep.data = TRUE, verbose = FALSE, n.cores = 2)
best.iter <- gbm.perf(gbm.model, method = "cv")  # 用交叉检验确定最佳迭代次数
best.iter
impval <- summary(gbm.model, best.iter)  # 查看特征重要程度# 画出特征重要性图
barplot(impval[c(1 : 20), 2], names = impval[c(1 : 20), 1], col = rainbow(20), las = 2, cex.names = 0.5, ylim = c(0, 4),ylab = "特征的重要程度")
legend(16, 4.1, legend = impval[c(1 : 20), 1], fill = rainbow(20), bty = "o", ce)# 评价模型
gbm.pred <- predict.gbm(gbm.model, test.data, type = "response" )  # 预测
final.test <- read.csv("./data/Test_Master_result.csv")  # 导入真实结果
test.merge <- merge(test.idx, final.test, by = "Idx")
library(ROCR)
pred.both <- prediction(gbm.pred, test.merge$target)
perf.both <- performance(pred.both, "tpr", "fpr")
plot(perf.both, main = "ROC曲线", col = "blue", lwd = 5)  # 画出ROC曲线图
roc(test.merge$target, gbm.pred)  # 求出曲线下方面积

看书标记【R语言商务数据分析实战6】相关推荐

看书标记【R语言商务数据分析实战4】
看书标记--关于R语言 chapter 4 4.2 任务实现 [R语言商务数据分析实战4] chapter 4 财政收入预测分析从海量数据中发现隐藏的运行模式,并提供具有决策意义的信息.变量过多会 ...
看书标记【R语言商务数据分析实战5】
看书标记--关于R语言 chapter 5 5.2 任务实现 [R语言商务数据分析实战5] chapter 5 金融服务机构资金流量预测数据理解和预处理>>检验平稳性+纯随机性> ...
看书标记【R语言商务数据分析实战9】
看书标记--关于R语言 chapter 9 9.2 任务实现 [R语言商务数据分析实战9] chapter 9 餐饮企业综合分析统计分析>>ARIMA预测销售额>>协同过滤 ...
【R语言与数据分析实战】数据操作（一）：基于向量的处理与外部数据处理
目录 1.R中的常用数据集 2.读写CSV文件 (1) 读写CSV文件 (2) 读写对象文件 3.合并数据框的行与列 4.apply系数函数 (1) apply (2) lapply (3) sapp ...
【R语言与数据分析实战】R软件编程
目录 1.流程控制 (1) if语句 (2) 循环语句 2.运算 (1) 数值运算 (2) 向量运算 (3) NA处理 3.定义函数 (1) 可变长函数 (2) 嵌套函数 4.作用域 5.对象的不变性 ...
【R语言与数据分析实战】绘图
目录 1.散点图 2.图像选项 2.1 坐标轴名称 2.2 图形标题 2.3 点的类型 2.4 点的大小 2.5 颜色 2.6 坐标轴的取值范围 2.7 图像类型 2.8 线型 2.9 图形排列 2. ...
R语言医学数据分析实战（三）数据可视化
文章目录一.用R的基础绘图系统作图 1.函数plot() 2.直方图和密度曲线图 3.条形图 4.饼图 5.箱线图和小提琴图 6.克里夫兰点图二.用ggplot2包作图 1.初识ggplot2包 ...
R语言与数据分析实战1-基础
第1关:R语言的数据类型本关是我们的第一关,任务非常简单,只要搞清楚我们面对的数据类型是什么,并能实现数据类型之间的转换,就可以过关啦! # 将 "3.14" 赋值给变量 pi, ...
R语言与数据分析实战11-数据的删除
第1关:数据的删除在实际的数据分析任务中,我们所拿到的数据往往存在着各种瑕疵,比如大量的缺失值.野值.无效观测等,因此我们除了按照前序课程讲的那样提取出有用数据外,还可以将无效或者错误的数据直接进行 ...

看书标记【R语言商务数据分析实战6】

看书标记——关于R语言

chapter 6

6.2 任务实

看书标记【R语言商务数据分析实战6】相关推荐

最新文章

热门文章

看书标记【R语言 商务数据分析实战6】

看书标记——关于R语言

chapter 6

6.2 任务实

看书标记【R语言 商务数据分析实战6】相关推荐

最新文章

热门文章

看书标记【R语言商务数据分析实战6】

看书标记【R语言商务数据分析实战6】相关推荐