caretで独自アルゴリズムの実行

caretパッケージは,機械学習のモデル構築・評価を統一したフレームワークで実行するための機能を提供している.caretのバージョン6.0.29では150個のアルゴリズムが利用できる.

> library(caret)
> packageVersion("caret")
[1]6.0.29’
> head(modelLookup())
   model parameter          label forReg forClass probModel
1    ada      iter         #Trees  FALSE     TRUE      TRUE
2    ada  maxdepth Max Tree Depth  FALSE     TRUE      TRUE
3    ada        nu  Learning Rate  FALSE     TRUE      TRUE
4 avNNet      size  #Hidden Units   TRUE     TRUE      TRUE
5 avNNet     decay   Weight Decay   TRUE     TRUE      TRUE
6 avNNet       bag        Bagging   TRUE     TRUE      TRUE
> length(unique(modelLookup()[, "model"]))
[1] 150

ユーザは,caretで提供されているアルゴリズム以外のものも追加できる.そのためにはまず, caretで実装されているモデルがどのような情報を含んでいるかについて理解する必要がある.

> # サポートベクタマシン (RBF カーネル ) の情報を取得
> svmRadial.ModelInfo <- getModelInfo(model = "svmRadial", regex = FALSE)[[1]]
> names(svmRadial.ModelInfo)
 [1] "label"      "library"    "type"       "parameters" "grid"      
 [6] "loop"       "fit"        "predict"    "prob"       "predictors"
[11] "tags"       "levels"     "sort"      

以上の結果を見ると,13個の情報を保持していることが分かる.これらを含めて,14個の情報を保持できる.それぞれの意味を下表に示す.

パラメータ 内容 データ型
library 【必須】予測モデルのフィッティングや予測に用いるパッケージの名称 character
type 【必須】予測の種別. "Classification":クラス分類, "Regression":回帰, もしくは両方を指定 character
parameters 【必須】ハイパーパラメータの名前,型,名称 data.frame
grid 【必須】ハイパーパラメータの探索範囲を生成する関数 function
fit 【必須】モデルをフィッティングする関数 function
predict 【必須】予測を行う関数 function
prob 【必須】クラス確率を算出する関数 function
sort 【必須】ハイパーパラメータを最も複雑なものからソートする関数 function
loop 【任意】予測モデルが複数のサブモデルの予測を返す場合に指定する関数 function
levels 【任意】クラス分類モデルに対して,予測値のカテゴリ水準を返す関数 function
tags 【任意】予測モデルに関連するタグ(例:"Tree-Based Model","Embedded Feature Selection") character
label 【任意】予測モデルのラベル(例:"Linear Discriminant Analysis") character
predictors 【任意】説明変数の名前のベクトル character
varImp 【任意】説明変数の重要度を算出する関数 function

caretは,ラプラスカーネルのサポートベクタマシンは提供していない.caretのホームページの説明を参考に,このアルゴリズムを追加してみよう.

> # ラプラスカーネルのサポートベクタマシンを追加するための設定
> ## 1. 新規リストの作成
> svmLP <- list(type = "Classification", library = "kernlab", loop = NULL)

> ## 2. ハイパーパラメータの指定
> prm <- data.frame(parameter = c("C", "sigma"), class = rep("numeric", 2),
+                   label = c("Cost", "Sigma"))
> prm
  parameter   class label
1         C numeric  Cost
2     sigma numeric Sigma
> svmLP$parameters <- prm

> ## 3. ハイパーパラメータのデフォルトの探索範囲の指定
> svmGrid <- function(x, y, len = NULL) {
+              library(kernlab)
+              sigmas <- sigest(as.matrix(x), na.action = na.omit, scaled = TRUE)
+              expand.grid(sigma = mean(sigmas[-2]), C = 2^((1:len) - 3))
+            }
> svmLP$grid <- svmGrid

> ## 4. フィッティング関数の指定
> svmFit <- function(x, y, wts, param, lev, last, weights, classProbs, ...) {
+             ksvm(x = as.matrix(x), y = y, kernel = rbfdot, 
+                  kpar = list(sigma = param$sigma), C = param$C, 
+                  prob.model = classProbs, ...)
+           }
> svmLP$fit <- svmFit

> ## 5. 予測を実行する関数の指定
> svmPred <- function(modelFit, newdata, preProc = NULL, submodels = NULL) {
+              predict(modelFit, newdata)
+            }
> svmLP$predict <- svmPred

> ## 6. クラス確率を推定する関数の指定
> svmProb <- function(modelFit, newdata, preProc = NULL, submodels = NULL) {
+              predict(modelFit, newdata, type = "probabilities")
+            }
> svmLP$prob <- svmProb

> ## 7. ハイパーパラメータをソートする関数の指定
> svmSort <- function(x) x[order(x$C), ]
> svmLP$sort <- svmSort

> ## 8. クラスの水準の指定
> svmLP$levels <- function(x) lev(x)

> # 設定の確認
> svmLP
$type
[1] "Classification"

$library
[1] "kernlab"

$loop
NULL

$parameters
  parameter   class label
1         C numeric  Cost
2     sigma numeric Sigma

$grid
function (x, y, len = NULL) 
{
    library(kernlab)
    sigmas <- sigest(as.matrix(x), na.action = na.omit, scaled = TRUE)
    expand.grid(sigma = mean(sigmas[-2]), C = 2^((1:len) - 3))
}

$fit
function (x, y, wts, param, lev, last, weights, classProbs, ...) 
{
    ksvm(x = as.matrix(x), y = y, kernel = rbfdot, kpar = list(sigma = param$sigma), 
        C = param$C, prob.model = classProbs, ...)
}

$predict
function (modelFit, newdata, preProc = NULL, submodels = NULL) 
{
    predict(modelFit, newdata)
}

$prob
function (modelFit, newdata, preProc = NULL, submodels = NULL) 
{
    predict(modelFit, newdata, type = "probabilities")
}

$sort
function (x) 
x[order(x$C), ]

$levels
function (x) 
lev(x)

C50パッケージは,顧客の離反を予測するためのデータセットchurnTrain, churnTestを提供している.ここでは,訓練用のchurnTrainデータセットを用いて,上記で定義したsvmLPを用いて学習してみよう.

library(C50)
> head(churnTrain, 3)
  state account_length     area_code international_plan voice_mail_plan
1    KS            128 area_code_415                 no             yes
2    OH            107 area_code_415                 no             yes
3    NJ            137 area_code_415                 no              no
  number_vmail_messages total_day_minutes total_day_calls
1                    25             265.1             110
2                    26             161.6             123
3                     0             243.4             114
  total_day_charge total_eve_minutes total_eve_calls total_eve_charge
1            45.07             197.4              99            16.78
2            27.47             195.5             103            16.62
3            41.38             121.2             110            10.30
  total_night_minutes total_night_calls total_night_charge
1               244.7                91              11.01
2               254.4               103              11.45
3               162.6               104               7.32
  total_intl_minutes total_intl_calls total_intl_charge
1               10.0                3              2.70
2               13.7                3              3.70
3               12.2                5              3.29
  number_customer_service_calls churn
1                             1    no
2                             1    no
3                             0    no
> # 10-fold クロスバリデーションの実行
> fit.lpSVM <- train(churn ~., data=churnTrain, method=svmLP, 
+                    preProc=c("center", "scale"), 
+                    trContorl=trainControl(number=10))
> fit.lpSVM
3333 samples
  19 predictors
   2 classes: 'yes', 'no' 

Pre-processing: centered, scaled 
Resampling: Bootstrapped (25 reps) 

Summary of sample sizes: 3333, 3333, 3333, 3333, 3333, 3333, ... 

Resampling results across tuning parameters:

  C     Accuracy  Kappa   Accuracy SD  Kappa SD
  0.25  0.853     0       0.00712      0       
  0.5   0.854     0.0198  0.00747      0.0171  
  1     0.867     0.192   0.00807      0.0471  

Tuning parameter 'sigma' was held constant at a value of 0.00747278
Accuracy was used to select the optimal model using  the largest value.
The final values used for the model were C = 1 and sigma = 0.00747.