R语言实现变量分箱及应用
2023-06-13 09:17:27 时间
cut_bin <- function(df, key_var, y_var, max_depth, p) {
library(rpart)
df_bin <- df[, c(key_var, y_var)]
Xvar_df<- df[-which(colnames(df) %in% c(key_var, y_var))]
lst_bin<- list()
j<-0
for (col in colnames(Xvar_df)) {
if (class(df[, col]) != 'character') {
fit <- rpart(
df[, y_var] ~ df[, col],
data = df,
method = "anova",
control = rpart.control(
xval = 10,
minbucket = round(p*nrow(df)),
maxdepth = max_depth,
cp = 0.0001
)
)
splits <- fit$splits[, 'index']
vec<-NULL
if (length(splits) == 1) {
vec[df[, col] < splits[1]] <- 1
vec[df[, col] >= splits[1]] <- 2
inter_bin<- rbind(c(1, -1000000000, splits[1]), c(2, splits[1], 1000000000))
}
else if (length(splits) > 1) {
splits <- sort(splits)
vec[df[, col] < splits[1]] <- 1
inter_bin<- matrix(c(1, -1000000000, splits[1]), nrow=1)
rownames(inter_bin)<-1
for (i in 1:(length(splits) - 1)) {
vec[df[, col] >= splits[i] & df[, col] < splits[i + 1]] <- i + 1
inter_bin<- rbind(inter_bin, c(i+1, splits[i], splits[i + 1]))
rownames(inter_bin)[i+1]<-i+1
}
vec[df[, col] >= splits[length(splits)]] <-length(splits) + 1
inter_bin<- rbind(inter_bin, c(length(splits) + 1, splits[length(splits)], 1000000000))
rownames(inter_bin)[length(splits)+1]<-length(splits)+1
}
else {
vec <- 1
inter_bin<- matrix(c(1, -1000000000, 1000000000), nrow=1)
}
# data.frame->bin
df_bin[, col]<-vec
# Freq&BadRate
inter_df<-as.data.frame(inter_bin)
colnames(inter_df)<- c('bin', 'lower', 'upper')
zz1<-data.frame(prop.table(table(df_bin[, col])))
zz2<-data.frame(prop.table(table(df_bin[, col],df_bin[, y_var]), 1))
Freq<-zz1$Freq
BadRate<-zz2$Freq[zz2$Var2==1]
inter_df<-cbind(inter_df, Freq, BadRate)
inter_df$lower<-round(inter_df$lower, 2)
inter_df$upper<-round(inter_df$upper, 2)
# bin->list
lst_temp<- list(inter_df=inter_df)
lst_bin<-c(lst_bin, lst_temp)
j<-j+1
names(lst_bin)[j]<-col
}
all<- list(lst_bin=lst_bin, df_bin=df_bin)
}
return(all)
}
输出对象存放在列表all中,all中包含2个元素,lst_bin是变量分箱结果的列表,df_bin是分好箱的数据集。下面查看lst_bin中某变量分箱结果和df_bin。
某变量分箱结果
分箱后的数据集df_bin
下面函数将训练样本上分箱方式“套进” 测试样本里。其中df是测试样本数据集, key_var是主键, y_var是y值, lst_bin是训练样本上变量分箱结果的列表。该函数也输出一个列表,含有2个元素,其中lst_bin_test是测试样本上变量分箱结果的列表,df_bin是测试样本分箱结果数据集。
txt_bin<- function(df, key_var, y_var, lst_bin){
df_bin <- df[, c(key_var, y_var)]
var_df<- df[-which(colnames(df) %in% c(key_var, y_var))]
for (col in names(lst_bin)){
vec<-NULL
bin<- lst_bin[[col]]
for (i in 1:length(bin$bin)){
vec[df[, col]>=bin$lower[i] & df[, col]<bin$upper[i]]<- bin$bin[i]
}
df_bin[, col]<-vec
}
lst_bin_test<- list()
j<- 0
for (col in names(lst_bin)){
z1<-data.frame(prop.table(table(df_bin[, col], df_bin[, y_var]), 1))
z2<-data.frame(prop.table(table(df_bin[, col])))
z_df<-cbind(bin=z2$Var1, Freq=z2$Freq, BadRate=z1$Freq[z1$Var2==1])
inter_df<-merge(lst_bin[[col]][,1:3], z_df, by="bin", all=FALSE)
lst_temp<- list(inter_df=inter_df)
lst_bin_test<-c(lst_bin_test, lst_temp)
j<-j+1
names(lst_bin_test)[j]<-col
}
result<- list(lst_bin_test=lst_bin_test, df_bin=df_bin)
return(result)
}
上面的两个函数实现了变量分箱的自动化,现在想看看训练样本和测试样本里某个变量的趋势是否一致,编写函数plot_train_test_bin来实现该功能。其中TrainVar_bin是训练样本中某变量的分箱结果及风险趋势, TestVar_bin是测试样本中某变量的分箱结果及风险趋势。
plot_train_test_bin<-function(TrainVar_bin, TestVar_bin){
par(mfrow=c(1,2))
par(mar=c(3.5,3.5,3,3.1))
bar <- barplot(TrainVar_bin$Freq,ylim=c(0,1.3*max(TrainVar_bin$Freq)),col="gray")
mtext(TrainVar_bin$bin,side=1,line=0.5,at=bar,col="black")
mtext("Train bin",side=1,line=1.5,col="black")
mtext("Freq",side=2,line=2,col="black")
par(new=T)
plot(bar,TrainVar_bin$BadRate ,axes=F,ylim=c(0,1.3*max(TrainVar_bin$BadRate)),xlab="",ylab="",type="o")
axis(4,col="black",col.ticks="black",col.axis="black")
mtext("BadRate",side=4,line=2,col="black")
par(mar=c(3.5,3.1,3,3.5))
bar <- barplot(TestVar_bin$Freq,ylim=c(0,1.3*max(TestVar_bin$Freq)),col="gray")
mtext(TestVar_bin$bin,side=1,line=0.5,at=bar,col="black")
mtext("Test bin",side=1,line=1.5,col="black")
mtext("Freq",side=2,line=2,col="black")
par(new=T)
plot(bar,TestVar_bin$BadRate ,axes=F,ylim=c(0,1.3*max(TestVar_bin$BadRate)),xlab="",ylab="",type="o")
axis(4,col="black",col.ticks="black",col.axis="black")
mtext("BadRate",side=4,line=2,col="black")
}
运行后的结果如下,左侧为该变量在训练样本上的趋势,右侧为测试样本上的趋势,从图中可以看出该变量的趋势在3和4两处发生了波动,具体实践时需要具体分析原因,或者看能否将3、4和5进行合并处理等等。
或者,在对上面这个变量分箱时增加叶子结点最小占比,看看分箱结果如何。从下图可以看出,调整后的变量趋势更加稳定了。
temp_train<-train[, c(key, y, TempVar)]
temp_train_all<-cut_bin(temp_train, key, y, 3, 0.1)
temp_train_lst_bin<-temp_train_all$lst_bin
temp_test<- test[, c(key, y, TempVar)]
temp_test_all<- txt_bin(temp_test, key, y, temp_train_lst_bin)
temp_test_lst_bin<- temp_test_all$lst_bin_test
plot_train_test_bin(temp_train_lst_bin[[TempVar]], temp_test_lst_bin[[TempVar]])
相关文章
- 网络 + AI,不止解决 5G 时代能耗、安全与应用三大难题
- php://input allow_url_include,php allow_url_include的应用和解释_PHP教程
- 为应用提供 64 位原生支持 | Android 中文教学视频
- R语言分布滞后非线性模型(DLNM)空气污染研究温度对死亡率影响建模应用|附代码数据
- 一文聊透Apache Hudi的索引设计与应用
- chatGPT的49种应用场景,双AI生成二次元仙女,及各开发语言对接chatGPT参考指南
- R语言Fama-French三因子模型实际应用:优化投资组合|附代码数据
- R语言谱聚类社会化推荐挖掘协同过滤电影社交网站Flixster数据集应用研究
- Go 语言 Web 应用怎么使用 Nginx 部署?
- 【DBMS 数据库管理系统】数据仓库 ( 数据仓库简介 | 操作型数据与分析性数据对比 | 数据仓库特征 | 特征一 : 面向主题组织数据 | 面向应用 | )
- 你的Flutter应用该考虑迁移代码了:Dart 3将在2023年成为100%健全的空安全语言
- 【C 语言】动态库封装与设计 ( 动态库调用环境搭建 | 创建应用 | 拷贝动态库相关文件到源码路径 | 导入头文件 | 配置动态库引用 | 调用动态库中的函数 )
- 微软宣布更新微软翻译应用增加9种新语言支持 总支持语言提升至83种
- 快速掌握C语言开发MySQL数据库应用(c语言mysql数据库)
- Linux 批量重命名工具的应用(批量重命名linux)
- 开发嵌入式Linux应用——C语言实战(嵌入式linuxc语言)
- 探究linux源码:集群应用下的神秘面纱(集群linux源码)
- MYSQL中字符与字节的关系及应用场景(mysql字符字节)
- 循环语句的应用详解MySQL中for(mysql中for)
- c语言与oracle数据库融合强大的实效应用(c语言oracle数据库)
- oracle中新闻计算机语言DEC的应用(dec在oracle中)
- 用MySQL和C语言编程,快速构建高效数据库应用(mysql_,c语言编程)
- 开发中的应用利用Redis缓存提升项目开发效率(redis缓存在项目)
- ORACLE数据库应用开发常见问题及排除
- javascript当onmousedown、onmouseup、onclick同时应用于同一个标签节点Element