*disclaimer
603043
判別分析
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) #オプションをもとに戻す
- references
群馬大の青木先生の「判別分析」スクリプト
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
https://sugiura-ken.org/wiki/