Rで判別分析、13手法
データ分析の勉強をしてて、いろいろな人の分析を見てみると
「モデル選択時には手法三つくらい試していいものを使った」
などというコメントが多く、
「このデータにはこの手法!」みたいな固まった考え方よりも、
ある程度データに対応していそうな手法が見えた場合、どんどん手を動かすのが良いのではないかと思いました。
というわけで、手を動かすためにも手法を多く知っておくべきと思い、
広く浅く手法を試してみました。
最初に感想
手法をやってみて思ったのが、どの手法でもなかなか良い結果を出してくれて、
手法選択に凝り固まるよりも、手法はとりあえずいくつか試してみてよさそうなのを選ぶのがコスパ(手法に悩む時間的な)が良いかと思いました。
ただ、機械学習でよく躓く部分でもありますが、パラメータチューニングや過学習の防止などは付きまとってくる問題だなぁと再認識しました。
手法選択よりも、適切化する磨き上げには時間をかける必要がありそうです。
データの発生
今回は、XORのような想定で1,1や-1,-1なら赤、1,0や0,1なら緑として、分類できるかを試していきます。
set.seed(1)
#データの発生
x<-c(rnorm(50,-1,0.5),rnorm(50,1,0.5),rnorm(50,-1,0.5),rnorm(50,1,0.5))
y<-c(rnorm(50,-1,0.5),rnorm(50,1,0.5),rnorm(50,1,0.5),rnorm(50,-1,0.5))
labels<-c(rep("1",100),rep("2",100))
#データと正解を分ける
xors=data.frame(x=x,y=y,label=as.factor(labels))
no_label_xors=xors[,-3]
label_xors=xors[,3]
#以降で使用するパラメータの定義
xlimit=c(-3,3)
ylimit=c(-3,3)
#判別境界を知るためにグリッドデータを発生させておく
#グリッドデータの各値を判別させて、色を塗って分けさせる
px <- seq(-3, 3, 0.01)
py <- seq(-3, 3, 0.01)
pgrid <- expand.grid(px, py)
names(pgrid) <- c("x", "y")
とりあえずplot
plot(xors$x,xors$y,type="n")
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
#赤と緑が分別したいデータ
#ただし部分的に被っているところがあり、分別するのが難しい
1番-kernlabのサポートベクトルマシン
library( kernlab )
model.ksvm<-ksvm(label ~., data=xors)
#毎回モデルは変化する non チューニング
plot(1,xlim=xlimit,ylim=ylimit,type="n")
pred.pgrid.ksvm <- predict(model.ksvm, pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.ksvm)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
それっぽく判別できていそうです。
2番-caretのsvm
library(caret)
model.caret.svm<-train(label~.,data=xors,
method="svmRadial",
trace=T,
tuneLength=1)
#tuneLength パラメータチューニングを何パターンしますか
#print(model.caret.svm)
#str(model.caret.svm)
pred.pgrid.c.svm<-predict(model.caret.svm,pgrid)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.c.svm)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
tuneLength1
tuneLength3
tuneLength5
tuneLength20
3番-e1071のSVM
library( e1071 )
model.e.svm<-svm(label ~., data=xors)
#print(model.e.svm)
pred.pgrid.e.svm<-predict(model.e.svm,pgrid)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.e.svm)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
4番-e1071のナイーブベイズ
library( e1071 )
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.nb<-naiveBayes(label ~., data=xors)
pred.pgrid.nb<-predict(model.nb,pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.nb)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
もはややっつけ
5番-決定木
library(rpart)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.rp = rpart(label ~ ., data = xors)
pred.pgrid.rp<-predict(model.rp,pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(1-round(pred.pgrid.rp), dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
大変綺麗で驚きました。
rpartの中身をplotしてみると
library(rpart.plot)
rpart.plot(model.rp, type = 1, uniform = TRUE, extra = 1, under = 1, faclen = 0)
さらに別のモデル可視化
library(partykit)
plot(as.party(model.rp))
6番-ランダムフォレスト
library(randomForest)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.rf = randomForest(label ~ ., data = xors)
pred.pgrid.rf<-predict(model.rf,pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.rf)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
細かいところまで推定しようとしてることがわかる。
7番-qda 二次判別
library(MASS)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.qda = qda(label ~ ., data = xors)
pred.pgrid.qda<-predict(model.qda,pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.qda$class)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
8番-k近傍法
library(class)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.knn=knn(train=no_label, test=pgrid, cl=xors[,3], k = 10, l = 0, prob = FALSE, use.all = TRUE)
#教師あり学習なのでclがクラスタのほんとの数に相当している。
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(model.knn)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
9番-boosting法
library(adabag)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.boosting<-boosting(label~.,data=xors)
pred.pgrid.boosting<-predict(model.boosting,pgrid)
#str(pred.pgrid.boosting)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.boosting$class)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
10番-バギング
library(adabag)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
model.bag<-bagging(label~.,data=xors)
pred.pgrid.bag<-predict(model.bag,pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.bag$class), dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
11番-lvq1
library(class)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
Minit<-lvqinit(xors[,1:2],xors[,3],k = 10)
model.lvq1<-lvq1(xors[,1:2],xors[,3],Minit, alpha = 0.5)
pred.pgrid.lvq1<-lvqtest(model.lvq1,pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.lvq1)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
12番-nnetのニューラルネット
library(nnet)
model.nn <- nnet(as.factor(label)~., data = xors, size = 5, rang = 0.1,decay = 5e-4, maxit = 200)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
str(nn)
pred.pgrid.nn <- predict(model.nn, pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.nn)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
あまり最適とは言えない
こういうときはパラメーターのチューニングです。
チューニング
library(nnet)
library(caret)
fitControl <- trainControl(method = "repeatedcv", number = 5, repeats = 5)
fitGrid <- expand.grid(decay= c(0, 1e-4, 1e-3,1e-2,1e-1), size = (1:10)*1)
model.tune <- train(label~.,data=xors, method="nnet",
trace=F, trControl = fitControl, tuneGrid = fitGrid)
model.tune$bestTune$size
model.tune$bestTune$decay
結果
> model.tune$bestTune$size
[1] 7
> model.tune$bestTune$decay
[1] 0.1
チューニング結果の可視化
trellis.par.set(caretTheme())
plot(model.tune, metric = "Kappa", plotType = "level")
チューニング結果でもう一度nnet
best_size<-model.tune$bestTune$size
best_decay<-model.tune$bestTune$decay
library(nnet)
model.nn <- nnet(as.factor(label)~., data = xors, size = best_size, rang = 0.1,decay = best_decay, maxit = 200)
plot(1,xlim=xlimit,ylim=ylimit,type="n")
pred.pgrid.nn <- predict(model.nn, pgrid)
my.colors <- c("#FFCCCC","#CCFFCC")
image(px, py, array(as.numeric(pred.pgrid.nn)-1, dim=c(length(px), length(py))),
xlim=xlimit, ylim=ylimit, add=T, col = my.colors)
points(xors$x[xors$label==1],xors$y[xors$label==1],xlim=xlimit,ylim=ylimit,col="red")
points(xors$x[xors$label==2],xors$y[xors$label==2],xlim=xlimit,ylim=ylimit,col="green")
まだあまり納得いきません。
学習の難しいところです。
モデル可視化
library(NeuralNetTools)
plotnet(model.nn)
13番-k平均法
library(cluster)
no_label=xors[,-3]
cluster_xors<-kmeans(no_label,4)
plot(no_label)
clusplot(xors, cluster_xors$cluster, color=TRUE, shade=TRUE, labels=2, lines=0,add=T)
あまり四つのクラスタを綺麗に見つけてくれてない。
以上
参考サイト
https://momonoki2017.blogspot.com/2018/05/r009-r2.html
http://yut.hatenablog.com/entry/20120827/1346024147