r データサイエンティスト养成読本登竜门编「11-3 Rで机械学习を试してみよう」のソースコード

Posted 2021-05-24

# パッケージをインストールする
pkgs <- c("dplyr", "rpart", "rpart.plot", "rattle", "mlr", "evtree")
install.packages(pkgs, quiet = TRUE)

# パッケージを読み込む
library("dplyr")
library("rattle")
library("mlr")
library("evtree")

# 読み込まれたパッケージを確認する
search()

# 表示オプションを設定する
options(scipen = 100, dplyr.width = Inf, dplyr.print_max = Inf)

# evtreeパッケージのGerman Credit Dataを読み込む
data(GermanCredit)

# 簡単のため、必要な変数のみ抽出する
GermanCredit <- GermanCredit %>%
  select_(.dots = c("status", "duration", "purpose",
                    "credit_risk"))

# 以降、計算結果の再現性を確保するためにシード値を設定する
set.seed(123, "L'Ecuyer")

# GermanCreditデータに対する機械学習タスクの設定をする
GermanCredit.task <- makeClassifTask(id = "GermanCredit-Tutorial",
                                     data = GermanCredit,
                                     target = "credit_risk")

# 学習データ（70％）と検証データ（30％）を抽出するためのインデックスを作成する
test.index <- sample(1:1000, size = 300, replace = FALSE)
print(length(test.index))
train.index <- setdiff(1:1000, test.index)
print(length(train.index))

# 決定木でモデリングの実行の設定をする
tune.learner <- makeLearner(cl = "classif.rpart")

# パラメータチューニング用に訓練データのみ抽出するように設定する
GermanCredit.tune.task <- subsetTask(task = GermanCredit.task,
                                     subset = train.index)

# 5-分割交差検証の実行の設定をする
resampling <- makeResampleDesc(method = "CV", iters = 5L)

# グリッドサーチの実行の設定をする
control.grid <- makeTuneControlGrid()

# グリッドサーチのためのパラメータ空間を設定する
param.set <- makeParamSet(
  makeDiscreteParam("cp", values = c(0.1, 0.01)),
  makeDiscreteParam("maxdepth", values = c(3, 4))
)

# 5-分割交差検証における評価尺度として正解率(acc)を設定する
measures <- list(acc)

# グリッドサーチによるパラメータサーチを行う
tune.result = tuneParams(learner = tune.learner,
                         task = GermanCredit.tune.task,
                         resampling = resampling,
                         control = control.grid,
                         par.set = param.set,
                         measures = measures)

# パラメータサーチ結果を表示する
optimize.grid <- as_data_frame(tune.result$opt.path)
print(optimize.grid %>% select_(.dots = c("cp", "maxdepth", "acc.test.mean")))
# A tibble: 4 × 3
#       cp maxdepth acc.test.mean
#   <fctr>   <fctr>         <dbl>
# 1    0.1        3     0.7028571
# 2   0.01        3     0.7300000
# 3    0.1        4     0.7028571
# 4   0.01        4     0.7500000

# 最適なパラメータで決定木モデルを構築するように設定する
train.learner <- makeLearner(cl = "classif.rpart",
                             cp = tune.result$x$cp,
                             maxdepth = tune.result$x$maxdepth)

# 最適なパラメータで再度、検証データを予測するための決定木モデルを構築する
model <- train(learner = train.learner,
               task = GermanCredit.task,
               subset = train.index)

# 決定木をプロットし、pngファイルとして保存する
png("GermanCredit.rpart.png", width = 800, height = 500)
fancyRpartPlot(model$learner.model, sub = "", cex = 1.4)
dev.off()

# 検証データに対して予測する
task.pred <- predict(model, task = GermanCredit.task, subset = test.index)
# 予測結果を閲覧する
print(task.pred)
# Prediction: 300 observations
# predict.type: response
# threshold:
# time: 0.01
#      id truth response
# 167 167   bad     good
# 390 390  good     good
# 759 759  good     good
# 622 622   bad     good
# 929 929  good     good
# 551 551  good     good
# ... (300 rows, 3 cols)

# 混同行列（Confusion Matrix）を表示する
getConfMatrix(task.pred)
#        predicted
# true    good bad -SUM-
#   good   195  13    13
#   bad     77  15    77
#   -SUM-   77  13    90

# 正解率（Accuracy）を表示する
performance(task.pred, measures = measures)
# acc
# 0.7