とある技術者の徒然草

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

【R】kaggleにはじめて挑戦 Home CreditコンペでLightGBM

kaggle初挑戦。とりあえずSubmitしてみた。

機械学習エンジニアの世界ではkaggleというデータコンペティションが流行している。
企業がkaggleにデータ分析に関する課題を提供し、
参加者が主に予測精度などを競うサイトである。
こういうのを見るとアメリカは今までにない
サイトを作る文化があるんだなぁと感心する。

まずはHome Credit Default Analysisコンペに参加

参加したコンペはHome Credit Default Analysisである。
理由は特にない、参加者が多く、Rのコードが多かったからだ。
しかし、カーネルを見ているとほとんどがpythonで書かれたコードであった。
そろそろ、pythonも勉強した方が良いのだろうか。。

勉強になったカーネルHome Credit Default Analysis

下記にLightGBMの使い方について参考になったカーネルがあった。
写経してサブミットしてみる。

www.kaggle.com

rm(list=ls())

if (!require("pacman")) install.packages("pacman")
pacman::p_load(tidyverse, skimr, GGally, plotly, viridis, 
               caret, DT, data.table, lightgbm)


#dataload
train <-fread("../input/application_train.csv", stringsAsFactors = FALSE, showProgress=F,
              data.table = F, na.strings=c("NA","NaN","?", ""))
test <-fread('../input/application_test.csv', stringsAsFactors = FALSE, showProgress=F,
             data.table = F, na.strings=c("NA","NaN","?", ""))
bureau <-fread("../input/bureau.csv", stringsAsFactors = FALSE, showProgress=F,
               data.table = F, na.strings=c("NA","NaN","?", ""))
prev <-fread("../input/previous_application.csv", stringsAsFactors = FALSE, showProgress=F,
             data.table = F, na.strings=c("NA","NaN","?", ""))

#Let’s take 1000 observation as a sample and have a very brief look at the data.

train[sample(1:nrow)]


#preprocess
head(full)

full <- bind_rows(train,test)

#IDと目的変数を消す
Target <- train$TARGET
Id <- test$SK_ID_CURR
full[,c('SK_ID_CURR','TARGET')] <- NULL

#文字型のみ抽出
chr <- full[,sapply(full, is.character)]
#数値型のみ抽出
num <- full[,sapply(full, is.numeric)]

#文字型のnaにNAを代表する文字を代入
chr[is.na(chr)] <- "Not Available"

#ファクター化する
fac <- chr %>% 
  lapply(as.factor) %>% 
  as_data_frame()


full <- bind_cols(fac, num)
rm(chr, fac, num)

#数値型のNAに0を代入することになる
full[is.na(full)] <- 0

#すべての列にnumericを適用してT/Fを返す。Tの列のみを返す
num <- train[, sapply(train,is.numeric)]
#sapply(iris,is.numeric)

rm(train, test)

#前処理が終わったのでfullを分割する
train <- full[1:length(Target),]
test <- full[(length(Target)+1):nrow(full),]

#Cross Validation Setup
#caretパッケージのcreateDataPartition関数は分割したデータの中で応答変数のクラスの比率が偏らないようにしてくれる
set.seed(123)
inTrain <- createDataPartition(Target, p=.9, list = F)

length(inTrain)/length(Target)

tr <- train[inTrain,]
va <- train[-inTrain,]

tr_ta <- Target[inTrain]
va_ta <- Target[-inTrain]

lgb.train = lgb.Dataset(data.matrix(tr), label = tr_ta)
lgb.valid = lgb.Dataset(data.matrix(va), label = va_ta)


params.lgb = list(
  objective = "binary"
  , metric = "auc"
  , min_data_in_leaf = 1
  , min_sum_hessian_in_leaf = 100
  , feature_fraction = 1
  , bagging_fraction = 1
  , bagging_freq = 0
)

# Get the time to train the lightGBM model

lgb.model <- lgb.train(
  params = params.lgb
  , data = lgb.train
  , valids = list(val = lgb.valid)
  , learning_rate = 0.05
  , num_leaves = 7
  , num_threads = 2
  , nrounds = 3000
  , early_stopping_rounds = 200
  , eval_freq = 50
)

#変数重要度を見る
# get feature importance
lgb.importance(lgb.model, percentage = TRUE) %>% head(20) %>% kable()

tree_imp <- lgb.importance(lgb.model, percentage = TRUE) %>% head(20)
lgb.plot.importance(tree_imp, measure = "Gain")

# make test predictions
lgb_pred <- predict(lgb.model, data = data.matrix(test), n = lgb.model$best_iter)
result <- data.frame(SK_ID_CURR = Id, TARGET = lgb_pred)
write.csv(result,"lgb_pred.csv", row.names = F)

変数重要度

f:id:M_taka072:20190302190932j:plain

スコア

f:id:M_taka072:20190302191327j:plain
スコア