とある技術者の徒然草

生産技術者の適当な日記(統計言語Rに関するメモがメイン)

【R言語】xgboostで分類

xgboostで分類

下のサイトを参考にしながらxgboostのパラメーターチューニングに取り組んだ。
備忘録として残しておく。

www.marketechlabo.com

logics-of-blue.com

使用したデータセットはコレ
Default of Credit Card Clients Dataset | Kaggle

library(tidyverse)
library(caret)
library(xgboost)
library(Matrix)
options(na.action='na.pass')

df <- fread("../R/default of credit card clients/UCI_Credit_Card.csv", stringsAsFactors = FALSE)
df_trainX <- select(df,-ID)
df_trainX <- as.data.frame(df_trainX)

traindata <- createDataPartition(y=df_trainX$default.payment.next.month,p=.8,list=FALSE,times = 1)

df_trainX <- select(df,-ID)
df_trainX$default.payment.next.month <- as.logical(df_trainX$default.payment.next.month )
#str(df_trainX)

df_train_sp_xg <- df_trainX[traindata,]
df_test_sp_xg <- df_trainX[-traindata,]

train_dmat <- xgb.DMatrix(
  sparse.model.matrix(default.payment.next.month ~ ., data = df_train_sp_xg),
  label = df_train_sp_xg$default.payment.next.month
)
options(na.action='na.omit')

#パラメーターを設定
l_params = list(
  booster = 'gbtree',
  objective = 'binary:logistic',
  eval_metric = 'auc',
  eta = 0.1,
  max_depth = 3,
  min_child_weight = 2,
  colsample_bytree = 0.8
)


# クロスバリデーションの実行
xgb_cv <- xgb.cv(
  data = train_dmat, 
  nrounds = 50000, # 最大の繰り返し回数を指定。十分大きな値を指定
  nfold = 5, # クロスバリデーションの分割数を指定
  params = l_params,
  early_stopping_rounds = 100 # ある回数を基準としてそこから100回以内に評価関数の値が改善しなければ計算をストップ
)

#xgb_cv$best_iterationがベストの木の数となる。これをnroundsに指定してモデルを構築
xgb_cv$best_iteration

xgb_model <- xgb.train(
  data = train_dmat,
  nrounds = xgb_cv$best_iteration,
  params = l_params
)

######watchlistを指定して検証データに対する評価関数の値を見て決めることもできた
#検証データ
previous_na_action <- options()$na.action
options(na.action='na.pass')
test_dmat <- xgb.DMatrix(
  sparse.model.matrix(default.payment.next.month ~ ., data = df_test_sp_xg),
  label = df_test_sp_xg$default.payment.next.month
)
options(na.action=previous_na_action) # NAに対する扱いを元に戻してお

#モデルの構築
xgb_model <- xgb.train(
  data = train_dmat,
  nrounds = 50000, # 最大の繰り返し回数を指定。十分大きな値を指定する。→1
  verbose = 2, # 繰り返し過程を表示する
  params = l_params,
  watchlist = list(train = train_dmat, eval = test_dmat), # このデータに対する評価関数の値をモニタリングする→2
  early_stopping_rounds = 100 # ある回数を基準としてそこから100回以内に評価関数の値が改善しなければ計算をストップ→3
)

#caretで実施
#チューニングできるパラメータをmodelLookup()で確認
modelLookup("xgbTree")

#https://www.kaggle.com/pelkoja/visual-xgboost-tuning-with-caret

tuneG = expand.grid( eta = c(0.05, 0.07,0.1,0.15 ),max_depth = c(1,2,3),
                     min_child_weight = c(1.5,2,2.5,3),colsample_bytree = 0.8,nrounds=162,gamma=0,subsample = 1)

trC = trainControl(method = 'cv', number = 5, allowParallel = TRUE, classProbs = TRUE, summaryFunction = twoClassSummary)

#並列計算させる
library(doParallel)
detectCores()
cl <- makePSOCKcluster(detectCores())
registerDoParallel(cl)

df_train_sp %>%
  mutate(default.payment.next.month = as.factor(default.payment.next.month)) %>% # 目的変数はfactor型
  mutate_if(is.factor, funs(make.names)) %>% # factor型のラベルが整数値になっているとNGなので変換
   train(
   default.payment.next.month ~ .,                              #formula:目的変数と説明変数の指定          
   data = .,                        #トレーニングデータ
   method = "xgbTree",                       #使う手法:XGBoostのgbtree(ツリーモデル)
   trControl = trC,  #クロスバリデーション
   tuneGrid = tuneG                           #パラメータチューニングの範囲
   ) ->xgbcaret

ExecuteParallelProcess()

#分類問題の場合は、confusionMatrix()という関数を使う
predict_xgb <- predict(xgbcaret,df_test_sp2[,-24])
ref_xgb <- as.factor(df_test_sp2$default.payment.next.month)
confusionMatrix(predict_xgb,ref_xgb)

predict_xgb2 <- predict(xgbcaret,df_test_sp2[,-24],type = "prob")#rawでクラスを返す


#ROC曲線をプロット
pred_xgb_df <- as.data.frame(predict_xgb2)
library(pROC)
roc_curve <- roc(response = as.factor(df_test_sp2$default.payment.next.month),predictor = pred_xgb_df$X0,lavels=c("no","yes"))
plot(roc_curve)
plot
auc(roc_curve)

#0,1がリファレンスと入れ替わっているので戻す
refclass <- if_else(as.integer(as.factor(df_test_sp2$default.payment.next.month))-1 == 0,1,0)
# TRUE or FLASE の後 整数に直している
pred_class <- (pred_xgb_df$X0 >0.5) %>% as.integer()
table(pred_class,refclass)

#カットオフ値を0.7に帰ると混同行列も変化する
pred_class2 <- (pred_xgb_df$X0 >0.7) %>% as.integer()
table(pred_class2,refclass)