利用Xgboost预测期货用户盈利概率

library(xgboost)
library(RMySQL)
attachNamespace('stringr')
library(stringr)
library(caTools)
library(DiagrammeR)
connectMySQL<-function(mysql,dbname,user,password,host){
  drv<-dbDriver(mysql)
  return(dbConnect(drv,dbname,user,password,host))
}
connect <- function()
{
  con <- connectMySQL(mysql = "MySQL", dbname = "BDC_DAM", user = "biadmin", password = "Abcd1234", host = "10.130.2.248")
  return(con)
}
con=connect()
dbSendQuery(con,"set names utf8;")
data=dbGetQuery(con,"select * from futures_user_fenbushi where substring(updatetime,1,10)='2016-10-26';")
library(data.table)
data1=as.data.table(data)
colnames(data1)=str_replace_all(colnames(data1),pattern = "/|\\-",replacement = "")
data1[,':='(y=ifelse(year_profit_rate>=0,1,0))]
data1[,':='(year_profit_rate=NULL,updatetime=NULL)]
col=str_detect(colnames(data1),"tag|adv_pre|start|id|end|updatetime|label|year_profit_rate")
data1=data1[,-col,with=F]

data1=data1[complete.cases(data1),]
split=sample.split(data1,0.8)
train=data1[split,]
test=data1[!split,]
train_matrix =as.matrix(train)
test_matrix =as.matrix(test)
train_label=train_matrix[,ncol(train_matrix)]
test_label=test_matrix[,ncol(test_matrix)]
dtrain=xgb.DMatrix(data=train_matrix[,-ncol(train_matrix)],label=train_label)
dtest=xgb.DMatrix(data=test_matrix[,-ncol(test_matrix)],label=test_label)

evalerror <- function(preds, dtrain) {
  labels <- getinfo(dtrain, "label")
  err <- sqrt(mean((preds-labels)^2))
  return(list(metric = "MSE", value = err))
}
param=list(objective='reg:logistic',max.depth=15,eta=0.3)
bst1=xgb.cv(dtrain,params = param,nrounds=1000,nfold = 20,prediction = T,feval=evalerror,maximize = F)

params=list(booster="gbtree",eta=1,gamma=1,max_depth=15,subsample=0.6,colsample=0.5,objective='reg:logistic',eval_metric=evalerror)

#开始构建模型 
bst=xgboost(data = train_matrix[,-ncol(train_matrix)],label=train_label,params = params,nrounds = which.min(bst1$evaluation_log$train_MSE_std))

#预测值 
pred=predict(bst,test_matrix[,-ncol(test_matrix)])
#模型评估 
library(ROCR)
predd=prediction(pred,test_label)
perf=performance(predd,'tpr','fpr')
plot(perf,colorize=T,print.cutoffs.at=seq(0,1,by=0.1))
auc=unlist(performance(predd,measure = "auc")@y.values)
#auc
cutoff=performance(predd,measure = "prbe")
#cutoff@y.values

model <- xgb.dump(bst, with_stats = T)
names <- dimnames(train_matrix[,-ncol(train_matrix)])[[2]]
importance_matrix <- xgb.importance(names, model = bst)
xgb.plot.importance(importance_matrix[1:10,])