トップ 履歴 一覧 Farm ソース 検索 ヘルプ PDF RSS ログイン

判別分析

*disclaimer
603043

R

判別分析



library(MASS)

  • 目的変数はカテゴリーで二値(L1 vs. L2とか男女とか、合格不合格とか)
  • 2つ以上の説明変数(二つだとグラフで表現しやすい)


全体のデータをランダムに半分ずつに分ける sample()

  • トレーニングデータ
  • テストデータ

トレーニングデータを使って判別モデルを作成

モデル <- lda(カテゴリー変数 ~ 変数A + 変数B, トレーニングデータ)

  • モデルのあてはまり具合を確認
予測結果1 <- predict(モデル, トレーニングデータ)
    • predict()内では、データの指定は「data = データ」としてはいけない。

table(予測結果1$class, トレーニングデータ$カテゴリー)

  • 判別率
tbl1 <-  table(予測結果1$class, トレーニングデータ$カテゴリー)

sum(diag(tbl1)) / sum(tbl1)


テストデータで検証

  • モデルを使って、テストデータを予測して(あてはめて)みる
予測結果2 <- predict(モデル, テストデータ)

table(予測結果2$class, テストデータ$カテゴリー)

  • 判別率
tbl2 <-  table(予測結果2$class, テストデータ$カテゴリー)

sum(diag(tbl2)) / sum(tbl2)


判別率の確認

install.packages("caret", dependencies =T)
library(caret)

confusionMatrix()を使う

  • このとき、予測結果のオブジェクトの中の class に予測値が入っている
> confusionMatrix(予測結果$class, テストデータ$gender)
Confusion Matrix and Statistics

          Reference
Prediction Female Male
    Female   2306  191
    Male      198 2305
                                          
               Accuracy : 0.9222          
                 95% CI : (0.9144, 0.9295)
    No Information Rate : 0.5008          
    P-Value [Acc > NIR] : <2e-16          
                                          
                  Kappa : 0.8444          
                                          
 Mcnemar's Test P-Value : 0.761           
                                          
            Sensitivity : 0.9209          
            Specificity : 0.9235          
         Pos Pred Value : 0.9235          
         Neg Pred Value : 0.9209          
             Prevalence : 0.5008          
         Detection Rate : 0.4612          
   Detection Prevalence : 0.4994          
      Balanced Accuracy : 0.9222          
                                          
       'Positive' Class : Female 

最初から、Leave One Outという交差検証法を使って、係数の平均を出す方法がある。

モデル <- lda(カテゴリー ~ ., data = データ全体, CV = T)
  • 最後の CV = T で、そのオプションを使用(Cross Validation)

判別直線の描写

  • こんなデータを例に
> lda.model
Call:
lda(gender ~ height + weight, data = heights.weights.first)

Prior probabilities of groups:
Female   Male 
0.4974 0.5026 

Group means:
         height   weight
Female 161.9052 61.72511
Male   175.1181 84.61170

Coefficients of linear discriminants:
               LD1
height -0.07010553
weight  0.15910727

  • 定数項の計算
teisu <- apply(lda.model$means %*% lda.model$scaling, 2, mean)

  • 判別式の直線の求め方(H: height, W: weight)
    • HとWを使った判別式
    • yが判別得点(0より上か下かで判別する)
    • それを 0 として、式の変換
    • y軸がheightなので、Hを求めるように
y = -teisu + lda.model$scaling[1]*H + lda.model$scaling[2]*W

0 = -teisu + lda.model$scaling[1]*H + lda.model$scaling[2]*W

H = teisu/lda.model$scaling[1]  - lda.model$scaling[2]*W/lda.model$scaling[1]

yc = teisu/lda.model$scaling[1]  - lda.model$scaling[2]*W/lda.model$scaling[1]
  • データをプロットして、
  • そこに、判別直線を重ねる
  • xcは、x軸の範囲、つまり、weightの最低値から最大値
  • ycが、xcに応じて計算されるy軸の値
plot(heights.weights.first$weight, heights.weights.first$height, col=c("blue", "red")[heights.weights.first$gender], cex=0.4)

par(new=T)

xc <- seq(min(heights.weights.first$weight), max(heights.weights.first$weight), 1)
yc <- teisu/lda.model$scaling[1]  - lda.model$scaling[2]*xc/lda.model$scaling[1]

points(x=xc, y=yc, type="l", col="black", lwd=2)

par(new=F) #オプションをもとに戻す

 群馬大の青木先生の「判別分析」スクリプト

http://aoki2.si.gunma-u.ac.jp/R/disc.html

  • disc() で分析
  • plot() でグラフ描写
    • plot(判別モデル, which="scatter", xpos="topleft")

source("http://aoki2.si.gunma-u.ac.jp/R/src/disc.R", encoding="euc-jp")

head(heights.weights.first)
     gender   height   weight
884    Male 185.5176 95.01636
5562 Female 165.3821 58.54528
8277 Female 162.2129 58.18927
612    Male 168.6387 74.87199
4768   Male 168.4758 79.68867
6881 Female 174.5236 74.89278

lda.aoki <- disc(heights.weights.first[2:3], heights.weights.first[1])

判別関数

         Female:Male Partial F p-value
height       0.19035  221.4431       0
weight      -0.43200 2539.8063       0
constant    -0.46693                  

分類関数

             Female       Male
height    -17.93674  -17.55605
weight     10.71814    9.85415
constant 1121.23638 1120.30252

判別結果

        prediction
group    Female Male
  Female   2294  193
  Male      198 2315

正判別率 = 92.2 %

plot(lda.aoki, which="scatter", xpos="topleft")

ステップワイズで

http://aoki2.si.gunma-u.ac.jp/R/sdis.html

 判別分析の例


 判別分析の例2

 References

http://daas.la.coocan.jp/GLM/tahenryou_03_discrim.htm
http://entertainment-lab.blogspot.com/2012/12/r.html
https://mikuhatsune.hatenadiary.com/entry/2021/02/12/165456
https://tatsukioike.com/rmult/0026/
http://www.kogures.com/hitoshi/javascript/r/discriminant/index.html