主要内容
1、数据批量读取整合
2、缺失值插补
3、数据深度分箱
4、聚类划分风险等级
5、聚类结果处理
6、构建贝叶斯网络，划分训练与测试集7:3，训练集上正确率99.80989%，测试集上正确率97.76786%
code
library(readxl)
packageVersion('readxl')
setwd("C:/R/working/523/新建文件夹/新数据")
##读取同一目录下的所有文件
path <- "C:/R/working/523/新建文件夹/新数据"
fileNames <- dir(path)
data <- lapply(fileNames, function(x){read_excel(x, col_names = TRUE)}) ##读取数据，结果为list
##从数据库中读取数据类似上面，获取要数据库里的文件名，写个正则筛选文件名后for循环读取。
# 将所有60个国家的数据合并在一起
merge_data <- as.data.frame(matrix(numeric(0),ncol=12))
names(merge_data) <- names(data[[1]])
for (i in 1:60) {
merge_data <- rbind(merge_data,data[[i]])
}
# 查看合并后数据的情况
dim(merge_data)
head(merge_data)
str(merge_data)
# 将X1-X11转化为数值型
for (j in 2:12) {
merge_data[,j] <- as.numeric(unlist(merge_data[,j]))
}
summary(merge_data) # 数据的基本情况
##############################################################缺失值插补########################################################
# 对缺失值使用装袋方法进行插补（方便后期数据离散化处理）
library(caret)
set.seed(12345)
preproc <- preProcess(merge_data,method="bagImpute")
data1 <- predict(preproc,merge_data)
#write.csv(data1,'data1.csv',fileEncoding = 'utf-8') # 保存插值结果
#避免每次插补的结果不一致，这里就行插补后将结果保存，下次直接读取data1.csv数据即可
data1 <- read.csv('C:\\R\\working\\523\\新建文件夹\\结果数据\\data1.csv',encoding = 'utf-8') # 读取插值结果
head(data1)
data2 <- data1[,-c(1,2)]
head(data2)
#################################################################数据分箱##############################################################################
# 构建等深分箱函数（Equal frequency intervals）
EFI <- function(data,parts,Min){
parts <- parts # 分几个箱
Min <- Min # 最小值
value<-quantile(data,probs = seq(0,1,1/parts)) #这里以data等比分为4段，步长为1/4
number<-mapply(function(x){
for (i in 1:(parts-1))
{
if(x>=(value[i]-Min)&x<value[i+1])
{
return(i)
}
}
if(x+Min>value[parts])
{
return(parts)
}
return(-1)
},data)
#打标签L1 L2
return(list(degree=paste("L",number,sep=""),degreevalue=number,value=table(value),number=table(number))) #将连续变量转化成定序变量，此时为L1,L2,L3,L4...根据parts
}
#深度分箱将X11列去掉（X11是0/1变量，不需要分箱处理）
tm_dt1 <- data2[-ncol(data2)]
#遍历数据进行数据深度分箱，风险系数越大，代表风险越大
for (k in 1:ncol(tm_dt1)) {
assign(paste0('EFI_',names(tm_dt1)[k]),EFI(tm_dt1[,k],5,min(tm_dt1[,k])))
temp_result <- eval(parse(text = paste0('EFI_',names(tm_dt1)[k])))
temp_devision_result <- as.data.frame(temp_result$value)
temp_devision_result$value <- as.numeric(as.character(temp_devision_result$value))
if(names(tm_dt1)[k] %in% c('X1','X2','X6','X8','X9','X10')){
tm_dt1[k] <- ifelse(tm_dt1[k]<temp_devision_result[2,1],'5',
ifelse(tm_dt1[k]<temp_devision_result[3,1],'4',
ifelse(tm_dt1[k]<temp_devision_result[4,1],'3',
ifelse(tm_dt1[k]<temp_devision_result[5,1],'2','1'))))
tm_dt1[,k] <- as.numeric(tm_dt1[,k])
}else {
tm_dt1[k] <- ifelse(tm_dt1[k]<temp_devision_result[2,1],'1',
ifelse(tm_dt1[k]<temp_devision_result[3,1],'2',
ifelse(tm_dt1[k]<temp_devision_result[4,1],'3',
ifelse(tm_dt1[k]<temp_devision_result[5,1],'4','5'))))
tm_dt1[,k] <- as.numeric(tm_dt1[,k])
}
}
# 分箱后的数据与X11合并
model_dt0 <- data.frame(tm_dt1,X11=data2$X11)
model_dt0[which(model_dt0$X11==0),ncol(model_dt0)] <- 5
summary(model_dt0)
#write.csv(model_dt0,'C:\\R\\working\\523\\新建文件夹\\结果数据\\model_dt0.csv',fileEncoding = 'utf-8')
#X3与X4共同反映金融市场稳定性，将其均值来反映金融市场稳定性指标
X34 <- apply(model_dt0[c(3:4)], 1, mean)
model_dt <- data.frame(model_dt0[-c(3,4)],X34)
head(model_dt)
#write.csv(model_dt,'C:\\R\\working\\523\\新建文件夹\\结果数据\\model_dt.csv',fileEncoding = 'utf-8')
############################################ 聚类确定风险等级#######################################################
#k-means 确定类数
# 0-1标准化
library(NbClust)
norm_data <- model_dt
for (n in 1:9) {
norm_data[,n] <- (norm_data[,n]-min(norm_data[,n]))/(max(norm_data[,n])-min(norm_data[,n]))
}
#最佳聚类数为2
nc <- NbClust(norm_data,min.nc = 2,max.nc = 10,method = "kmeans")
barplot(table(nc$Best.nc[1,]),
xlab="Number of Clusters",
ylab = "Number of Criteria",
main = "Number of Clusters Chosen by 26 Criteria")
#然而
#聚类5类
set.seed(10234)
data_kmeans5<-kmeans(norm_data,5,nstart=5)
result5_centers<-data_kmeans5$centers
data_kmeans5$size
#聚5类结果
result5<-data.frame(norm_data,cluster = data_kmeans5$cluster)
# 将各个变量的风险系数相加确定风险等级
riskGrade <- apply(result5_centers, 1, sum)
#将风险等级与cluster进行对应
result5[which(result5$cluster==1),ncol(result5)] <- 'Ⅰ'
result5[which(result5$cluster==2),ncol(result5)] <- 'Ⅳ'
result5[which(result5$cluster==3),ncol(result5)] <- 'Ⅲ'
result5[which(result5$cluster==4),ncol(result5)] <- 'Ⅴ'
result5[which(result5$cluster==5),ncol(result5)] <- 'Ⅱ'
#合并数据
model_data <- data.frame(model_dt,Risk_grade=result5$cluster)
head(model_data)
# write.csv(model_data,'C:\\R\\working\\523\\新建文件夹\\结果数据\\model_data.csv',fileEncoding = 'utf-8')
#原始数据加入风险等级
merge_dt <- data.frame(data2,Risk_grade=result5$cluster)
# write.csv(merge_dt,'C:\\R\\working\\523\\新建文件夹\\结果数据\\merge_dt.csv',fileEncoding = 'utf-8')
# 将model_data转化为factor
for (m in 1:ncol(model_data)) {
model_data[,m] <- as.factor(model_data[,m])
}
str(model_data)
# 训练集与测试集划分7:3
set.seed(123012)
train_number <-createDataPartition(y=model_data$Risk_grade,p=0.70,list=FALSE) # 测试数据序号
train <- model_data[train_number, ] #训练数据集
test <- model_data[-train_number, ] #测试集
###############################################构建贝叶斯网络模型###########################################
######################利用训练集训练模型#########################
library(bnlearn)
tan_train <- tree.bayes(train,"Risk_grade")
plot(tan_train)
modelstring(tan_train)
fit_result_train <- bn.fit(tan_train,train,method = "bayes")
fit_result_train
predict_train_train <- predict(fit_result_train,train)
temp_result_train <- table(predict_train_train,train[,"Risk_grade"])
# 正确率(99.80989%)
accuracy_rate_train <- ((sum(temp_result_train[row(temp_result_train)==col(temp_result_train)]))/sum(temp_result_train))*100
accuracy_rate_train
##############################预测##############################
predict_train <- predict(fit_result_train,test)
temp_result <- table(predict_train,test[,"Risk_grade"])
# 正确率(97.76786%)
accuracy_rate <- ((sum(temp_result[row(temp_result)==col(temp_result)]))/sum(temp_result))*100
accuracy_rate