そろそろ最適化問題を勉強したい:optim
そろそろ最適化問題を勉強したい:optim
最適化が必要な状況
順序予測を回帰でモデル構築した後に予測値を離散化して順序にしたい。
離散化のカットオフ値を決めるときに最適化が使えるらしい。
モデルの予測値が得られた後に現実に合わせるのに最適化は使えそう。
難しいことは置いといて簡単な考え方
難しいことはわからないので簡単イメージ。 高校で勉強した極値問題と考えると自分のなかではイメージしやすい。
簡単な問題:2次関数
簡単な問題。
極値を求める。
# 関数定義
f <- function(x) {
x ^ 2 + 3 * x + 1
}
f(3)
## [1] 19
library(ggplot2)
p <- ggplot(data=data.frame(X=c(-3,3)), aes(x=X))
p <- p + stat_function(fun=f)
p
# 最小化 グラフを見ると下に凸でx=-1.5ぐらいでy=-1.5ぐらいが最小値。
実際にoptim関数で計算する。
optim(par = -2, fn = f, method = "L-BFGS-B", lower = -3, upper = 3)
## $par
## [1] -1.5
##
## $value
## [1] -1.25
##
## $counts
## function gradient
## 4 4
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
結果はx=-1.5, y=-1.25。
最大化
グラフを見ると下に凸でx=3でy=19が最小値。
実際にoptim関数で計算する。
最大化する場合は control=list(fnscale=-1) を指定する。
optim(par = -2, fn = f, method = "L-BFGS-B", lower = -3, upper = 3, control=list(fnscale=-1))
## $par
## [1] -3
##
## $value
## [1] 1
##
## $counts
## function gradient
## 3 3
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
結果はx=-3, y=1。結果が間違い。
これは初期値 par = -2 を指定したことが原因。
極値が複数ある場合は局所最適に陥り全体最適にならない場合がある。
このような場合は初期値を複数試してみて全体最適を探る必要がある。
初期値 x = 0 で試してみる。
optim(par = 0, fn = f, method = "L-BFGS-B", lower = -3, upper = 3, control=list(fnscale=-1))
## $par
## [1] 3
##
## $value
## [1] 19
##
## $counts
## function gradient
## 2 2
##
## $convergence
## [1] 0
##
## $message
## [1] "CONVERGENCE: NORM OF PROJECTED GRADIENT <= PGTOL"
疑問:離散の最適化
ふと、離散の最適化について疑問に思った。
調べてみるとやはり難しい問題のようで、おいおい必要に応じて勉強したい。
今、私が求めている最適化問題
- 目的変数が順序尺度
- 回帰でモデルを構築
- モデルで計算した予測値を順序尺度にしたい
- 最も適したカットオフ値を求めたい
- モデルの評価指標は重み付きkappa
続きはまた後で。今回はここまで
いろいろ試したい時のデータセット:タイタニック
分析データを見つけるのは難しい
何かを試したい時に適したデータセットを見つけるのはなかなか難しい。
複数のデータセットを目的に応じて使い分けるのも骨が折れる。
ある程度汎用的に使えるデータセットを見つけたい。
iris?
有名なiris。
- 植物に興味がないので興味のあるデータではない。でも何度も使用したことがあるので馴染みはある。
- データ件数が150件で少ない。
- そのままでは2値分類に使用できない
求めるデータセット候補:タイタニック
kaggleで提供しているtitanic。
データ件数も変数の種類も豊富。映画も見ているので馴染みがある。
求めるデータセットに近い。
ただ、問題がひとつ。Rにデータセットが見つからない。
datasetsパッケージのTitanicはクロス集計に加工されたデータでローデータではない。
Titanic
## , , Age = Child, Survived = No
##
## Sex
## Class Male Female
## 1st 0 0
## 2nd 0 0
## 3rd 35 17
## Crew 0 0
##
## , , Age = Adult, Survived = No
##
## Sex
## Class Male Female
## 1st 118 4
## 2nd 154 13
## 3rd 387 89
## Crew 670 3
##
## , , Age = Child, Survived = Yes
##
## Sex
## Class Male Female
## 1st 5 1
## 2nd 11 13
## 3rd 13 14
## Crew 0 0
##
## , , Age = Adult, Survived = Yes
##
## Sex
## Class Male Female
## 1st 57 140
## 2nd 14 80
## 3rd 75 76
## Crew 192 20
kaggleのタイタニックデータセット
githubにパッケージを用意してくれていた。 https://github.com/paulhendricks/titanic
パッケージのインストール
githubからパッケージをインストール。
### パッケージのインストール
## library(devtools)
## install_github("paulhendricks/titanic")
library(titanic)
データ内容 titanic_train
library(knitr)
kable(head(titanic_train))
PassengerId | Survived | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
---|---|---|---|---|---|---|---|---|---|---|---|
1 | 0 | 3 | Braund, Mr. Owen Harris | male | 22 | 1 | 0 | A/5 21171 | 7.2500 | S | |
2 | 1 | 1 | Cumings, Mrs. John Bradley (Florence Briggs Thayer) | female | 38 | 1 | 0 | PC 17599 | 71.2833 | C85 | C |
3 | 1 | 3 | Heikkinen, Miss. Laina | female | 26 | 0 | 0 | STON/O2. 3101282 | 7.9250 | S | |
4 | 1 | 1 | Futrelle, Mrs. Jacques Heath (Lily May Peel) | female | 35 | 1 | 0 | 113803 | 53.1000 | C123 | S |
5 | 0 | 3 | Allen, Mr. William Henry | male | 35 | 0 | 0 | 373450 | 8.0500 | S | |
6 | 0 | 3 | Moran, Mr. James | male | NA | 0 | 0 | 330877 | 8.4583 | Q |
library(Hmisc)
describe(titanic_train)
## titanic_train
##
## 12 Variables 891 Observations
## ---------------------------------------------------------------------------
## PassengerId
## n missing unique Info Mean .05 .10 .25 .50
## 891 0 891 1 446 45.5 90.0 223.5 446.0
## .75 .90 .95
## 668.5 802.0 846.5
##
## lowest : 1 2 3 4 5, highest: 887 888 889 890 891
## ---------------------------------------------------------------------------
## Survived
## n missing unique Info Sum Mean
## 891 0 2 0.71 342 0.3838
## ---------------------------------------------------------------------------
## Pclass
## n missing unique Info Mean
## 891 0 3 0.81 2.309
##
## 1 (216, 24%), 2 (184, 21%), 3 (491, 55%)
## ---------------------------------------------------------------------------
## Name
## n missing unique
## 891 0 891
##
## lowest : Abbing, Mr. Anthony Abbott, Mr. Rossmore Edward Abbott, Mrs. Stanton (Rosa Hunt) Abelson, Mr. Samuel Abelson, Mrs. Samuel (Hannah Wizosky)
## highest: de Mulder, Mr. Theodore de Pelsmaeker, Mr. Alfons del Carlo, Mr. Sebastiano van Billiard, Mr. Austin Blyler van Melkebeke, Mr. Philemon
## ---------------------------------------------------------------------------
## Sex
## n missing unique
## 891 0 2
##
## female (314, 35%), male (577, 65%)
## ---------------------------------------------------------------------------
## Age
## n missing unique Info Mean .05 .10 .25 .50
## 714 177 88 1 29.7 4.00 14.00 20.12 28.00
## .75 .90 .95
## 38.00 50.00 56.00
##
## lowest : 0.42 0.67 0.75 0.83 0.92
## highest: 70.00 70.50 71.00 74.00 80.00
## ---------------------------------------------------------------------------
## SibSp
## n missing unique Info Mean
## 891 0 7 0.67 0.523
##
## 0 1 2 3 4 5 8
## Frequency 608 209 28 16 18 5 7
## % 68 23 3 2 2 1 1
## ---------------------------------------------------------------------------
## Parch
## n missing unique Info Mean
## 891 0 7 0.56 0.3816
##
## 0 1 2 3 4 5 6
## Frequency 678 118 80 5 4 5 1
## % 76 13 9 1 0 1 0
## ---------------------------------------------------------------------------
## Ticket
## n missing unique
## 891 0 681
##
## lowest : 110152 110413 110465 110564 110813
## highest: W./C. 6608 W./C. 6609 W.E.P. 5734 W/C 14208 WE/P 5735
## ---------------------------------------------------------------------------
## Fare
## n missing unique Info Mean .05 .10 .25 .50
## 891 0 248 1 32.2 7.225 7.550 7.910 14.454
## .75 .90 .95
## 31.000 77.958 112.079
##
## lowest : 0.000 4.013 5.000 6.237 6.438
## highest: 227.525 247.521 262.375 263.000 512.329
## ---------------------------------------------------------------------------
## Cabin
## n missing unique
## 204 687 147
##
## lowest : A10 A14 A16 A19 A20, highest: F33 F38 F4 G6 T
## ---------------------------------------------------------------------------
## Embarked
## n missing unique
## 889 2 3
##
## C (168, 19%), Q (77, 9%), S (644, 72%)
## ---------------------------------------------------------------------------
データ内容 titanic_test
kable(head(titanic_test))
PassengerId | Pclass | Name | Sex | Age | SibSp | Parch | Ticket | Fare | Cabin | Embarked |
---|---|---|---|---|---|---|---|---|---|---|
892 | 3 | Kelly, Mr. James | male | 34.5 | 0 | 0 | 330911 | 7.8292 | Q | |
893 | 3 | Wilkes, Mrs. James (Ellen Needs) | female | 47.0 | 1 | 0 | 363272 | 7.0000 | S | |
894 | 2 | Myles, Mr. Thomas Francis | male | 62.0 | 0 | 0 | 240276 | 9.6875 | Q | |
895 | 3 | Wirz, Mr. Albert | male | 27.0 | 0 | 0 | 315154 | 8.6625 | S | |
896 | 3 | Hirvonen, Mrs. Alexander (Helga E Lindqvist) | female | 22.0 | 1 | 1 | 3101298 | 12.2875 | S | |
897 | 3 | Svensson, Mr. Johan Cervin | male | 14.0 | 0 | 0 | 7538 | 9.2250 | S |
describe(titanic_test)
## titanic_test
##
## 11 Variables 418 Observations
## ---------------------------------------------------------------------------
## PassengerId
## n missing unique Info Mean .05 .10 .25 .50
## 418 0 418 1 1100 912.9 933.7 996.2 1100.5
## .75 .90 .95
## 1204.8 1267.3 1288.2
##
## lowest : 892 893 894 895 896, highest: 1305 1306 1307 1308 1309
## ---------------------------------------------------------------------------
## Pclass
## n missing unique Info Mean
## 418 0 3 0.83 2.266
##
## 1 (107, 26%), 2 (93, 22%), 3 (218, 52%)
## ---------------------------------------------------------------------------
## Name
## n missing unique
## 418 0 418
##
## lowest : Abbott, Master. Eugene Joseph Abelseth, Miss. Karen Marie Abelseth, Mr. Olaus Jorgensen Abrahamsson, Mr. Abraham August Johannes Abrahim, Mrs. Joseph (Sophie Halaut Easu)
## highest: de Brito, Mr. Jose Joaquim de Messemaeker, Mr. Guillaume Joseph del Carlo, Mrs. Sebastiano (Argenia Genovesi) van Billiard, Master. James William van Billiard, Master. Walter John
## ---------------------------------------------------------------------------
## Sex
## n missing unique
## 418 0 2
##
## female (152, 36%), male (266, 64%)
## ---------------------------------------------------------------------------
## Age
## n missing unique Info Mean .05 .10 .25 .50
## 332 86 79 1 30.27 8.0 16.1 21.0 27.0
## .75 .90 .95
## 39.0 50.0 57.0
##
## lowest : 0.17 0.33 0.75 0.83 0.92
## highest: 62.00 63.00 64.00 67.00 76.00
## ---------------------------------------------------------------------------
## SibSp
## n missing unique Info Mean
## 418 0 7 0.67 0.4474
##
## 0 1 2 3 4 5 8
## Frequency 283 110 14 4 4 1 2
## % 68 26 3 1 1 0 0
## ---------------------------------------------------------------------------
## Parch
## n missing unique Info Mean
## 418 0 8 0.53 0.3923
##
## 0 1 2 3 4 5 6 9
## Frequency 324 52 33 3 2 1 1 2
## % 78 12 8 1 0 0 0 0
## ---------------------------------------------------------------------------
## Ticket
## n missing unique
## 418 0 363
##
## lowest : 110469 110489 110813 111163 112051
## highest: W./C. 14260 W./C. 14266 W./C. 6607 W./C. 6608 W.E.P. 5734
## ---------------------------------------------------------------------------
## Fare
## n missing unique Info Mean .05 .10 .25 .50
## 417 1 169 1 35.63 7.229 7.642 7.896 14.454
## .75 .90 .95
## 31.500 79.200 151.550
##
## lowest : 0.000 3.171 6.438 6.496 6.950
## highest: 227.525 247.521 262.375 263.000 512.329
## ---------------------------------------------------------------------------
## Cabin
## n missing unique
## 91 327 76
##
## lowest : A11 A18 A21 A29 A34
## highest: F G63 F2 F33 F4 G6
## ---------------------------------------------------------------------------
## Embarked
## n missing unique
## 418 0 3
##
## C (102, 24%), Q (46, 11%), S (270, 65%)
## ---------------------------------------------------------------------------
dplyr:group_by に嵌る
dplyr:group_by に嵌る
kanosuke
問題
dplyrのgroup_byを使用してグループ別の集計処理をしたかったのだが
グループ処理が働かずに嵌った。
問題例
library(dplyr)
library(plyr)
mtcars %>% group_by(vs, am) %>% summarise(max = max(mpg))
## max
## 1 33.9
グループ別の最大値を求めたいのに一つの値しか得られない。
検索 “dplyr group_by not working”
検索ワード「dplyr group_by not working」で検索して情報を得た。
I believe you’ve loaded plyr after dplyr, which is why you are getting an overall summary instead of a grouped summary.
dplyrの後にplyr をロードするとだめらしい。
問題解決例
library(dplyr)
library(plyr)
detach(package:plyr)
mtcars %>% group_by(vs, am) %>% summarise(max = max(mpg))
## Source: local data frame [4 x 3]
## Groups: vs
##
## vs am max
## 1 0 0 19.2
## 2 0 1 26.0
## 3 1 0 24.4
## 4 1 1 33.9
xgboostを試してみる
xgboostを試してみる
kanosuke
2015年11月03日
xgboostで精度の高いモデルを構築できるらしい。
それから、fevalでモデル精度指標を指定できるところも良さそう。
xgboostを試してみたい。
まずは試してみる。
caretを使用すると色々なモデルが共通の文法で書けるので便利。
library(caret)
## Loading required package: lattice
## Loading required package: ggplot2
model1 <- train(
Species ~ .,
iris,
method="xgbTree"
)
## Loading required package: xgboost
## Loading required package: plyr
model1
## eXtreme Gradient Boosting
##
## 150 samples
## 4 predictor
## 3 classes: 'setosa', 'versicolor', 'virginica'
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 150, 150, 150, 150, 150, 150, ...
## Resampling results across tuning parameters:
##
## max_depth nrounds Accuracy Kappa Accuracy SD Kappa SD
## 1 50 0.9485004 0.9220085 0.02628702 0.03960171
## 1 100 0.9463580 0.9187624 0.02515099 0.03790241
## 1 150 0.9455416 0.9174981 0.02573184 0.03884031
## 2 50 0.9468626 0.9194865 0.02621117 0.03952144
## 2 100 0.9475898 0.9206234 0.02740915 0.04130599
## 2 150 0.9475898 0.9206234 0.02740915 0.04130599
## 3 50 0.9506307 0.9251477 0.02432345 0.03674940
## 3 100 0.9513580 0.9262899 0.02443380 0.03685994
## 3 150 0.9512716 0.9261698 0.02402944 0.03625242
##
## Tuning parameter 'eta' was held constant at a value of 0.3
## Accuracy was used to select the optimal model using the largest value.
## The final values used for the model were nrounds = 100, max_depth = 3
## and eta = 0.3.
summary(model1)
## Length Class Mode
## handle 1 xgb.Booster.handle externalptr
## raw 90996 -none- raw
## xNames 4 -none- character
## problemType 1 -none- character
## tuneValue 3 data.frame list
## obsLevels 3 -none- character
思ったよりも簡単にできた。
feval
fevalで独自の評価関数を指定したい。
マニュアルを確認する。
feval custimized evaluation function.
Returns list(metric=‘metric-name’, value=‘metric-value’)
with given prediction and dtrain.
caret:train で試してみる。
評価関数はrmspeを自作する。
rmspe <- function(prediction, dtrain) {
.observed <- getinfo(dtrain, "label")
list(
metric = "RMSPE",
value = sqrt(mean(((.observed- prediction) / .observed) ^ 2))
)
}
model2 <- train(
Sepal.Length ~ Sepal.Width + Petal.Length + Petal.Width,
iris,
method = "xgbTree",
feval = rmspe
)
model2
## eXtreme Gradient Boosting
##
## 150 samples
## 4 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 150, 150, 150, 150, 150, 150, ...
## Resampling results across tuning parameters:
##
## max_depth nrounds RMSE Rsquared RMSE SD Rsquared SD
## 1 50 0.3583983 0.8086825 0.02845745 0.04300446
## 1 100 0.3592624 0.8085968 0.02550611 0.04302866
## 1 150 0.3633599 0.8053671 0.02583143 0.04393736
## 2 50 0.3638931 0.8022369 0.03145324 0.04766807
## 2 100 0.3780569 0.7881979 0.03225296 0.05362911
## 2 150 0.3892047 0.7772812 0.03294389 0.05639148
## 3 50 0.3745153 0.7923352 0.02861350 0.04923131
## 3 100 0.3925762 0.7754515 0.03001914 0.05058433
## 3 150 0.4014436 0.7671566 0.03145388 0.05187344
##
## Tuning parameter 'eta' was held constant at a value of 0.3
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were nrounds = 50, max_depth = 1
## and eta = 0.3.
だめ。RMSEが評価指標として採用されている。 私の知識ではcaret:trainでfevalを指定できない。
feval xgboost:xgb.train でfevalを指定
caretを使用しないと新しい文法をマニュアルなどで調べないといけないので嫌だが、とにかく試してみる。
watchlist
目的変数やクロスバリデーション用のデータはwatchlistに指定するらしい。
また、xgb.DMatrix 形式にする必要があるらしい?
.feature <- data.matrix(iris[, 2:4])
.watchlist <- list(
val = xgb.DMatrix(data = .feature, label = iris$Sepal.Length),
train = xgb.DMatrix(data = .feature, label = iris$Sepal.Length)
)
xgb.train で試してみる。
model.3 <- xgb.train(
data = xgb.DMatrix(data = .feature, label = iris$Sepal.Length),
nround = 10,
watchlist = .watchlist,
feval=rmspe
)
## [0] val-RMSPE:0.641076263296985 train-RMSPE:0.641076263296985
## [1] val-RMSPE:0.450932635857561 train-RMSPE:0.450932635857561
## [2] val-RMSPE:0.318373538117156 train-RMSPE:0.318373538117156
## [3] val-RMSPE:0.227032609122525 train-RMSPE:0.227032609122525
## [4] val-RMSPE:0.164214553125964 train-RMSPE:0.164214553125964
## [5] val-RMSPE:0.120398490746834 train-RMSPE:0.120398490746834
## [6] val-RMSPE:0.0907635245058501 train-RMSPE:0.0907635245058501
## [7] val-RMSPE:0.0706479694183348 train-RMSPE:0.0706479694183348
## [8] val-RMSPE:0.0571393392305592 train-RMSPE:0.0571393392305592
## [9] val-RMSPE:0.0484302684656021 train-RMSPE:0.0484302684656021
summary(model.3)
## Length Class Mode
## handle 1 xgb.Booster.handle externalptr
## raw 7312 -none- raw
なんかできた。
dplyr, mutateを用いたデータハンドリング, data wrangling
dplyr, mutateを用いたデータハンドリング, data wrangling
kanosuke
2015年10月21日
モデル構築前の前処理
モデル構築する前には前処理が必要。
むしろ、前処理の方がが時間がかかる。
モデル構築ではトレーニング用とテスト用に分割するので
2つのデータセットに同じ前処理を施す。
この前処理群の管理や新変数名の設定方法など
煩雑になりがちで困っていたが自分なりの実践方法を整理しておきたい。
mutate_eachの気になる点
以前のブログで触れたがmutate_eachの気になる点として、
適用する関数が一つの場合に元変数を上書きしてしまう。
一つの関数で元変数が上書きされる例
library(dplyr)
##
## Attaching package: 'dplyr'
##
## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter, lag
##
## 以下のオブジェクトは 'package:base' からマスクされています:
##
## intersect, setdiff, setequal, union
iris <- tbl_df(iris)
mutate_each(iris, funs(log), -Species)
## Source: local data frame [150 x 5]
##
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## (dbl) (dbl) (dbl) (dbl) (fctr)
## 1 1.629241 1.252763 0.3364722 -1.6094379 setosa
## 2 1.589235 1.098612 0.3364722 -1.6094379 setosa
## 3 1.547563 1.163151 0.2623643 -1.6094379 setosa
## 4 1.526056 1.131402 0.4054651 -1.6094379 setosa
## 5 1.609438 1.280934 0.3364722 -1.6094379 setosa
## 6 1.686399 1.360977 0.5306283 -0.9162907 setosa
## 7 1.526056 1.223775 0.3364722 -1.2039728 setosa
## 8 1.609438 1.223775 0.4054651 -1.6094379 setosa
## 9 1.481605 1.064711 0.3364722 -1.6094379 setosa
## 10 1.589235 1.131402 0.4054651 -2.3025851 setosa
## .. ... ... ... ... ...
解決策
あまり綺麗な方法ではないがeval関数を使用することで解決する。
mutate_each(iris, funs(eval, log), -Species)
## Source: local data frame [150 x 13]
##
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## (dbl) (dbl) (dbl) (dbl) (fctr)
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa
## 7 4.6 3.4 1.4 0.3 setosa
## 8 5.0 3.4 1.5 0.2 setosa
## 9 4.4 2.9 1.4 0.2 setosa
## 10 4.9 3.1 1.5 0.1 setosa
## .. ... ... ... ... ...
## Variables not shown: Sepal.Length_eval (dbl), Sepal.Width_eval (dbl),
## Petal.Length_eval (dbl), Petal.Width_eval (dbl), Sepal.Length_log (dbl),
## Sepal.Width_log (dbl), Petal.Length_log (dbl), Petal.Width_log (dbl)
余分に作成される変数 *_eval はあとで削除する。
mutate_each(iris, funs(eval, log), -Species) %>%
select(-ends_with("_eval"))
## Source: local data frame [150 x 9]
##
## Sepal.Length Sepal.Width Petal.Length Petal.Width Species
## (dbl) (dbl) (dbl) (dbl) (fctr)
## 1 5.1 3.5 1.4 0.2 setosa
## 2 4.9 3.0 1.4 0.2 setosa
## 3 4.7 3.2 1.3 0.2 setosa
## 4 4.6 3.1 1.5 0.2 setosa
## 5 5.0 3.6 1.4 0.2 setosa
## 6 5.4 3.9 1.7 0.4 setosa
## 7 4.6 3.4 1.4 0.3 setosa
## 8 5.0 3.4 1.5 0.2 setosa
## 9 4.4 2.9 1.4 0.2 setosa
## 10 4.9 3.1 1.5 0.1 setosa
## .. ... ... ... ... ...
## Variables not shown: Sepal.Length_log (dbl), Sepal.Width_log (dbl),
## Petal.Length_log (dbl), Petal.Width_log (dbl)
前処理の関数化
前処理を関数化することで異なるデータセットに処理を適用するようにする。
- Species を文字列に型変換
- 数値型の4変数を対数変換
- 数値型の値が5以上の場合は5に丸める。
.wrangling <- function(.data) {
.data %>%
mutate(Species_as.character = as.character(Species)) %>%
mutate_each(
funs(
eval,
log,
round5 = ifelse(. > 5, 5, .)
),
-starts_with("Species")
) %>%
select(-ends_with("_eval"))
}
iris.wrangling <- .wrangling(iris)
summary(iris.wrangling)
## Sepal.Length Sepal.Width Petal.Length Petal.Width
## Min. :4.300 Min. :2.000 Min. :1.000 Min. :0.100
## 1st Qu.:5.100 1st Qu.:2.800 1st Qu.:1.600 1st Qu.:0.300
## Median :5.800 Median :3.000 Median :4.350 Median :1.300
## Mean :5.843 Mean :3.057 Mean :3.758 Mean :1.199
## 3rd Qu.:6.400 3rd Qu.:3.300 3rd Qu.:5.100 3rd Qu.:1.800
## Max. :7.900 Max. :4.400 Max. :6.900 Max. :2.500
## Species Species_as.character Sepal.Length_log Sepal.Width_log
## setosa :50 Length:150 Min. :1.459 Min. :0.6931
## versicolor:50 Class :character 1st Qu.:1.629 1st Qu.:1.0296
## virginica :50 Mode :character Median :1.758 Median :1.0986
## Mean :1.755 Mean :1.1074
## 3rd Qu.:1.856 3rd Qu.:1.1939
## Max. :2.067 Max. :1.4816
## Petal.Length_log Petal.Width_log Sepal.Length_round5 Sepal.Width_round5
## Min. :0.000 Min. :-2.3026 Min. :4.300 Min. :2.000
## 1st Qu.:0.470 1st Qu.:-1.2040 1st Qu.:5.000 1st Qu.:2.800
## Median :1.470 Median : 0.2624 Median :5.000 Median :3.000
## Mean :1.175 Mean :-0.1723 Mean :4.955 Mean :3.057
## 3rd Qu.:1.629 3rd Qu.: 0.5878 3rd Qu.:5.000 3rd Qu.:3.300
## Max. :1.932 Max. : 0.9163 Max. :5.000 Max. :4.400
## Petal.Length_round5 Petal.Width_round5
## Min. :1.000 Min. :0.100
## 1st Qu.:1.600 1st Qu.:0.300
## Median :4.350 Median :1.300
## Mean :3.565 Mean :1.199
## 3rd Qu.:5.000 3rd Qu.:1.800
## Max. :5.000 Max. :2.500
caret:trainに慣れる
caret:trainに慣れる
kanosuke
2015年10月19日
パッケージ caret
色々なアルゴリズムを個別のパッケージで対応してきた。
でも、それぞれの使い方を調べながら対応するのが面倒。
caretは多くのアルゴリズムを一つのパッケージにまとめてくれている。
また、モデル構築で必要なツールを提供してくれている。
caret:train
caret:trainでモデルを構築する。
オプション:method
method = でアルゴリズムを指定。多くのアルゴリズムを指定できる。
今回は“lm”, “rf”, “gbm”を使用する。
シンプルなモデル構築
library(caret)
library(dplyr)
iris <- tbl_df(iris)
model.lm <- train(
data = iris,
Sepal.Length ~ .,
method = "lm"
)
model.rf <- train(
data = iris,
Sepal.Length ~ .,
method = "rf"
)
model.gbm <- train(
data = iris,
Sepal.Length ~ .,
method = "gbm"
)
model.lm
## Linear Regression
##
## 150 samples
## 4 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 150, 150, 150, 150, 150, 150, ...
## Resampling results
##
## RMSE Rsquared RMSE SD Rsquared SD
## 0.3248528 0.8457439 0.01828276 0.02130072
##
##
summary(model.lm)
##
## Call:
## lm(formula = .outcome ~ ., data = dat)
##
## Residuals:
## Min 1Q Median 3Q Max
## -0.79424 -0.21874 0.00899 0.20255 0.73103
##
## Coefficients:
## Estimate Std. Error t value Pr(>|t|)
## (Intercept) 2.17127 0.27979 7.760 1.43e-12 ***
## Sepal.Width 0.49589 0.08607 5.761 4.87e-08 ***
## Petal.Length 0.82924 0.06853 12.101 < 2e-16 ***
## Petal.Width -0.31516 0.15120 -2.084 0.03889 *
## Speciesversicolor -0.72356 0.24017 -3.013 0.00306 **
## Speciesvirginica -1.02350 0.33373 -3.067 0.00258 **
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## Residual standard error: 0.3068 on 144 degrees of freedom
## Multiple R-squared: 0.8673, Adjusted R-squared: 0.8627
## F-statistic: 188.3 on 5 and 144 DF, p-value: < 2.2e-16
model.rf
## Random Forest
##
## 150 samples
## 4 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 150, 150, 150, 150, 150, 150, ...
## Resampling results across tuning parameters:
##
## mtry RMSE Rsquared RMSE SD Rsquared SD
## 2 0.3749241 0.8155266 0.03152655 0.03701402
## 3 0.3629939 0.8235616 0.02747483 0.03561889
## 5 0.3627847 0.8207195 0.02842011 0.03995335
##
## RMSE was used to select the optimal model using the smallest value.
## The final value used for the model was mtry = 5.
summary(model.rf)
## Length Class Mode
## call 4 -none- call
## type 1 -none- character
## predicted 150 -none- numeric
## mse 500 -none- numeric
## rsq 500 -none- numeric
## oob.times 150 -none- numeric
## importance 5 -none- numeric
## importanceSD 0 -none- NULL
## localImportance 0 -none- NULL
## proximity 0 -none- NULL
## ntree 1 -none- numeric
## mtry 1 -none- numeric
## forest 11 -none- list
## coefs 0 -none- NULL
## y 150 -none- numeric
## test 0 -none- NULL
## inbag 0 -none- NULL
## xNames 5 -none- character
## problemType 1 -none- character
## tuneValue 1 data.frame list
## obsLevels 1 -none- logical
model.gbm
## Stochastic Gradient Boosting
##
## 150 samples
## 4 predictor
##
## No pre-processing
## Resampling: Bootstrapped (25 reps)
## Summary of sample sizes: 150, 150, 150, 150, 150, 150, ...
## Resampling results across tuning parameters:
##
## interaction.depth n.trees RMSE Rsquared RMSE SD
## 1 50 0.3913974 0.7822964 0.03051559
## 1 100 0.3737524 0.7994068 0.02906737
## 1 150 0.3706075 0.8027339 0.02712242
## 2 50 0.3741219 0.7996173 0.02745996
## 2 100 0.3688091 0.8048558 0.02672018
## 2 150 0.3675264 0.8055333 0.02610464
## 3 50 0.3712947 0.8009253 0.02792836
## 3 100 0.3684993 0.8043281 0.02672187
## 3 150 0.3710270 0.8023887 0.02685090
## Rsquared SD
## 0.03417764
## 0.03301104
## 0.03097777
## 0.02871627
## 0.02685198
## 0.02633916
## 0.02546331
## 0.02405717
## 0.02456531
##
## Tuning parameter 'shrinkage' was held constant at a value of 0.1
##
## Tuning parameter 'n.minobsinnode' was held constant at a value of 10
## RMSE was used to select the optimal model using the smallest value.
## The final values used for the model were n.trees = 150,
## interaction.depth = 2, shrinkage = 0.1 and n.minobsinnode = 10.
summary(model.gbm)
## var rel.inf
## Petal.Length Petal.Length 79.9216869
## Sepal.Width Sepal.Width 9.0176394
## Petal.Width Petal.Width 5.4888793
## Speciesversicolor Speciesversicolor 5.3919231
## Speciesvirginica Speciesvirginica 0.1798713
rfとgbmはパラメータチューニングのため複数モデルを構築し性能が良いモデルのパラメータを採用している。
rfはmtryを、gbmはinteraction.depthとn.treesをチューニングしている。
モデルの評価はRMSEを採用。
rfはmtry=5のモデル、gbmはinteraction.depth = 2, n.trees = 150 のモデルを採用。
最終結果として
- lm : RMSE = 0.324
- rf : RMSE = 0.362
- gbm : RMSE = 0.367
lmのモデルが最も性能が良い。
後でパラーメータチューニング、リサンプリングの指定方法を整理したいが今日はここまで。
欠損値置換や因子ベクトル化をmutate_eachで
欠損値置換や因子ベクトル化をmutate_eachで
kanosuke
2015年10月17日
Rでのデータ加工がいつも捗らなくて困っていた。
dplyrをより活用することでもっと効率的にしたい。
そのなかでもmutate_eachは使う場面が多そうなので慣れておきたい。
全変数を因子ベクトル化
例えば、カテゴリ型の変数名を指名して対象変数を因子ベクトルにしたいことは多い。
自作のコードが煩雑になり困っていた。
そこでdplyr:mutate_eachを使用してみる。
irisの全変数をfactorで因子ベクトル化する。
それから関数はmutate_eachとmutate_each_がある。 (違いは他を当たってください)
library(dplyr)
##
## Attaching package: 'dplyr'
##
## 以下のオブジェクトは 'package:stats' からマスクされています:
##
## filter, lag
##
## 以下のオブジェクトは 'package:base' からマスクされています:
##
## intersect, setdiff, setequal, union
packageVersion("dplyr")
## [1] '0.4.3'
iris <- tbl_df(iris)
iris.factor <- mutate_each(iris, funs(factor))
str(iris.factor)
## Classes 'tbl_df', 'tbl' and 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: Factor w/ 35 levels "4.3","4.4","4.5",..: 9 7 5 4 8 12 4 8 2 7 ...
## $ Sepal.Width : Factor w/ 23 levels "2","2.2","2.3",..: 15 10 12 11 16 19 14 14 9 11 ...
## $ Petal.Length: Factor w/ 43 levels "1","1.1","1.2",..: 5 5 4 6 5 8 5 6 5 6 ...
## $ Petal.Width : Factor w/ 22 levels "0.1","0.2","0.3",..: 2 2 2 2 2 4 3 2 2 1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
変数を指定する。
変数名はlistなどで指定できる。その他にも便利な指定方法があるようなので他を当たってみてください。
iris.factor2 <- mutate_each_(iris, funs(factor), list("Sepal.Length", "Species"))
str(iris.factor2)
## Classes 'tbl_df', 'tbl' and 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: Factor w/ 35 levels "4.3","4.4","4.5",..: 9 7 5 4 8 12 4 8 2 7 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
iris.factor2 <- mutate_each(iris, funs(factor), Species)
iris.factor2 <- mutate_each_(iris, funs(factor), list(quote(Species), quote(Sepal.Length)))
iris.factor2 <- mutate_each(iris, funs(factor), -Species)
iris.factor2 <- mutate_each_(iris, funs(factor), "-Sepal.Length")
新規追加する変数名
一つ困っていることがある。
funsで関数名を指定する。指定した関数がひとつの場合は元の変数を上書きする。
指定した関数が2つ以上の場合は元の変数を上書きせず、関数名をsuffixとした新規変数を作成する。
適用したい関数がひとつの場合でも元の変数を残したいのだがその方法がわからない。
str(mutate_each_(iris, funs(half = ./2), list("Sepal.Length", "Sepal.Width")))
## Classes 'tbl_df', 'tbl' and 'data.frame': 150 obs. of 5 variables:
## $ Sepal.Length: num 2.55 2.45 2.35 2.3 2.5 2.7 2.3 2.5 2.2 2.45 ...
## $ Sepal.Width : num 1.75 1.5 1.6 1.55 1.8 1.95 1.7 1.7 1.45 1.55 ...
## $ Petal.Length: num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
str(mutate_each_(iris, funs(half = ./2, log), list("Sepal.Length", "Sepal.Width")))
## Classes 'tbl_df', 'tbl' and 'data.frame': 150 obs. of 9 variables:
## $ Sepal.Length : num 5.1 4.9 4.7 4.6 5 5.4 4.6 5 4.4 4.9 ...
## $ Sepal.Width : num 3.5 3 3.2 3.1 3.6 3.9 3.4 3.4 2.9 3.1 ...
## $ Petal.Length : num 1.4 1.4 1.3 1.5 1.4 1.7 1.4 1.5 1.4 1.5 ...
## $ Petal.Width : num 0.2 0.2 0.2 0.2 0.2 0.4 0.3 0.2 0.2 0.1 ...
## $ Species : Factor w/ 3 levels "setosa","versicolor",..: 1 1 1 1 1 1 1 1 1 1 ...
## $ Sepal.Length_half: num 2.55 2.45 2.35 2.3 2.5 2.7 2.3 2.5 2.2 2.45 ...
## $ Sepal.Width_half : num 1.75 1.5 1.6 1.55 1.8 1.95 1.7 1.7 1.45 1.55 ...
## $ Sepal.Length_log : num 1.63 1.59 1.55 1.53 1.61 ...
## $ Sepal.Width_log : num 1.25 1.1 1.16 1.13 1.28 ...