LoginSignup
1

More than 3 years have passed since last update.

【機械学習】判別分析・13手法【R言語・判別分析】

Last updated at Posted at 2019-08-23

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")
#赤と緑が分別したいデータ
#ただし部分的に被っているところがあり、分別するのが難しい

image.png

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")

image.png

それっぽく判別できていそうです。

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

image.png

tuneLength3

image.png

tuneLength5

image.png

tuneLength20

image.png

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")

image.png

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")

もはややっつけ

image.png

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")

大変綺麗で驚きました。

image.png

rpartの中身をplotしてみると

library(rpart.plot)
rpart.plot(model.rp, type = 1, uniform = TRUE, extra = 1, under = 1, faclen = 0)

image.png

さらに別のモデル可視化

library(partykit)
plot(as.party(model.rp))

image.png

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")

細かいところまで推定しようとしてることがわかる。

image.png

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")

image.png

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")

image.png

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")

image.png

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")

image.png

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")

image.png

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")

あまり最適とは言えない

image.png

こういうときはパラメーターのチューニングです。

チューニング

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") 

image.png

チューニング結果でもう一度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")

image.png

まだあまり納得いきません。
学習の難しいところです。

モデル可視化

library(NeuralNetTools)
plotnet(model.nn)

image.png

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)

image.png

あまり四つのクラスタを綺麗に見つけてくれてない。

以上

参考サイト

https://momonoki2017.blogspot.com/2018/05/r009-r2.html
http://yut.hatenablog.com/entry/20120827/1346024147

Register as a new user and use Qiita more conveniently

  1. You get articles that match your needs
  2. You can efficiently read back useful information
  3. You can use dark theme
What you can do with signing up
1