-
Notifications
You must be signed in to change notification settings - Fork 1
/
response_rate.R
116 lines (106 loc) · 4.27 KB
/
response_rate.R
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
library(data.table)
library(xgboost)
set.seed(66)
#use fread to accelerate the data input speed
#fread is much faster than read.csv()
train=fread('train.csv', header = T, sep = ',', stringsAsFactors=TRUE)
#convert to data.frame
train=as.data.frame(train)
test=fread('test.csv', header = T, sep = ',', stringsAsFactors=TRUE)
#convert to data.frame
test=as.data.frame(test)
###data engineering part
#convert factor features to numeric features if we wanna use xgboost
indx <- sapply(train, is.factor)
train[indx] <- lapply(train[indx], function(x) as.numeric(factor(x)))
test[indx] <- lapply(test[indx], function(x) as.numeric(factor(x)))
###dealing with missing values
#check the missing value summary, this method is not very efficient in R
#I guess the main reason is that "is.na" is not efficient
table(is.na(train))
table(is.na(test))
###replacing missing values with -1
train[is.na(train)] <- -1
test[is.na(test)] <- -1
###split training data into training part and validate part
## 70% of the sample size
smp_size <- floor(0.70 * nrow(train))
## set the seed to make your partition reproductible
train_ind <- sample(seq_len(nrow(train)), size = smp_size)
dtrain <- xgb.DMatrix(data = data.matrix(train[train_ind,2:ncol(train)-1]),label = train$target[train_ind])
dval <- xgb.DMatrix(data = data.matrix(train[-train_ind,2:ncol(train)-1]),label = train$target[-train_ind])
## set parameters for xgboost
watchlist <- list(eval = dval, train = dtrain)
param <- list( objective = "binary:logistic",
eta = 0.020,
max_depth = 6,
eval_metric = "auc"
)
## training a XGBoost classifier
clf <- xgb.train( params = param,
data = dtrain,
nrounds = 200,
verbose = 1,
early_stop_round = 20,
watchlist = watchlist,
maximize = TRUE)
## Traing Result
## eval-auc:0.772939 train-auc:0.814457
## output the confusion matrix and Statistics
library(caret)
xgbval <- predict(clf, dval)
xgbval <- ifelse(xgbval > 0.5,1,0)
confusionMatrix(xgbval, train$target[-train_ind])
# Reference
#Prediction 0 1
# 0 32141 7748
# 1 1275 2406
####We can also use mlr to do random (or grid) search to tune parameters of xgboost
####find the parameters with least error as our final parameters for training
####Here is an example for xgboost parameters tuning by mlr
traintask <- makeClassifTask(data = train[train_ind,2:ncol(train)],target = "target")
#create learner
lrn <- makeLearner("classif.xgboost",predict.type = "prob")
lrn$par.vals <- list(
objective="binary:logistic",
eval_metric="auc",
nrounds=200,
eta=0.020
)
#set parameter space
params_tune <- makeParamSet(
makeDiscreteParam("booster",values = c("gbtree","gblinear")),
makeIntegerParam("max_depth",lower = 3L,upper = 10L),
makeNumericParam("min_child_weight",lower = 1L,upper = 10L),
makeNumericParam("subsample",lower = 0.5,upper = 1),
makeNumericParam("colsample_bytree",lower = 0.5,upper = 1)
)
#set resampling strategy
rdesc <- makeResampleDesc("CV",stratify = T,iters=5L)
#search strategy
ctrl <- makeTuneControlRandom(maxit = 10L)
#set parallel backend
library(parallel)
library(parallelMap)
parallelStartSocket(cpus = detectCores())
#parameter tuning
mytune <- tuneParams(learner = lrn
,task = traintask
,resampling = rdesc
,measures = acc
,par.set = params_tune
,control = ctrl
,show.info = T)
##The following code is for final testing data prediction
# Making predictions in batches if the computer has memory limitation
predict_res <- data.frame(ID=test$ID)
predict_res$target <- NA
for (rows in split(1:nrow(test), ceiling((1:nrow(test))/10000))) {
predict_res[rows, "target"] <- predict(clf, data.matrix(test[rows, 2:ncol(train)-1]))
}
#edit threshold to have binary prediction results
predict_res <- ifelse(predict_res > 0.5,1,0)
#Otherwise
#predict_res <- predict(clf, data.matrix(test[rows, 2:ncol(train)-1]))
## Output the final testing data prediction results into csv file
write_csv(predict_res, "response_rate_test_res.csv")