R 判別分析 !!!判別分析の例２ {{outline}} ---- !!データ !注意 *判別するカテゴリーはファクター型 !NICERのデータを例に *学習者データと母語話者データより、以下の言語的特徴量を調べた結果のデータ・フレーム（all_indexes.df）を例として。 {{pre str(all_indexes.df) ## 'data.frame': 452 obs. of 12 variables: ## $ ID : chr "JPN501" "JPN502" "JPN503" "JPN504" ... ## $ Topic: chr "sports" "education" "education" "sports" ... ## $ Score: chr "4" "4" "3" "4" ... ## $ Type : int 134 160 121 139 175 124 151 98 104 99 ... ## $ Token: int 638 712 402 520 840 522 724 396 526 366 ... ## $ TTR : num 0.42 0.449 0.602 0.535 0.417 ... ## $ GI : num 7.5 8.48 8.53 8.62 8.54 ... ## $ MATTR: num 0.426 0.455 0.606 0.539 0.423 ... ## $ AWL : num 4.3 4.23 4.75 4.77 4 ... ## $ ASL : num 10.63 12.28 15.46 9.63 16.8 ... ## $ NoS : int 30 29 13 27 25 20 26 20 19 14 ... ## $ Lang : Factor w/ 2 levels "1","2": 2 2 2 2 2 2 2 2 2 2 ... }} !!MASSパッケージの中のlda()を使って !6つの説明変数により話者がL1かL2かを判別するモデル {{pre library(MASS) DA.model <- lda(Lang ~ Type + Token + MATTR + AWL + ASL + NoS, data=all_indexes.df) DA.model ## Call: ## lda(Lang ~ Type + Token + MATTR + AWL + ASL + NoS, data = all_indexes.df) ## ## Prior probabilities of groups: ## 1 2 ## 0.1570796 0.8429204 ## ## Group means: ## Type Token MATTR AWL ASL NoS ## 1 387.2676 1973.0986 0.4103297 4.751333 22.59186 45.66197 ## 2 126.2073 558.2415 0.4712071 4.361718 12.87662 22.06824 ## ## Coefficients of linear discriminants: ## LD1 ## Type -0.030430371 ## Token 0.001101204 ## MATTR 2.009154987 ## AWL -0.449549288 ## ASL -0.019658983 ## NoS 0.028913641 }} !判別精度 {{pre hyou <- table(all_indexes.df$Lang, predict(DA.model)$class) hyou ## ## 1 2 ## 1 67 4 ## 2 0 381 }} !判別率：全体の数のうち、正しく判別できたものの割合 {{pre 正しく判別できたもの： 67 + 381 = 448 全体の数　　　　　　： 67 + 4 + 0 + 381 = 452 correct <- (hyou[1,1]+hyou[2,2])/sum(hyou) correct ## [1] 0.9911504 }} *DA.modelの場合、99%は正しく判別できている !!重要な説明変数の選択 !青木先生の関数を使用 http://aoki2.si.gunma-u.ac.jp/R/sdis.html source("http://aoki2.si.gunma-u.ac.jp/R/src/sdis.R", encoding="euc-jp") {{pre sdis.result <- sdis(all_indexes.df[4:11], all_indexes.df[12]) sdis.result ## 有効ケース数： 452 ## 群を表す変数： Lang ## ## ***** 平均値 ***** ## 1 2 全体 ## Type 387.2676056 126.2073491 167.2146018 ## Token 1973.0985915 558.2414698 780.4867257 ## TTR 0.4043734 0.4660248 0.4563406 ## GI 12.3755946 7.5715687 8.3261834 ## MATTR 0.4103297 0.4712071 0.4616445 ## AWL 4.7513327 4.3617179 4.4229184 ## ASL 22.5918585 12.8766212 14.4026873 ## NoS 45.6619718 22.0682415 25.7743363 ## ## ***** プールされた群内相関係数行列 ***** ## ## Type Token TTR GI MATTR AWL ## Type 1.00000000 0.9038982 -0.2653464 0.7685720 -0.2623123 -0.04618413 ## Token 0.90389816 1.0000000 -0.5369960 0.4498941 -0.5353729 -0.14042196 ## TTR -0.26534644 -0.5369960 1.0000000 0.2762727 0.9990017 0.26567511 ## GI 0.76857203 0.4498941 0.2762727 1.0000000 0.2815950 0.13298483 ## MATTR -0.26231234 -0.5353729 0.9990017 0.2815950 1.0000000 0.27001137 ## AWL -0.04618413 -0.1404220 0.2656751 0.1329848 0.2700114 1.00000000 ## ASL 0.25575020 0.2515538 -0.1885313 0.1729259 -0.1853512 0.20856585 ## NoS 0.66663032 0.7400935 -0.4415735 0.3457875 -0.4403156 -0.25905336 ## ASL NoS ## Type 0.2557502 0.6666303 ## Token 0.2515538 0.7400935 ## TTR -0.1885313 -0.4415735 ## GI 0.1729259 0.3457875 ## MATTR -0.1853512 -0.4403156 ## AWL 0.2085658 -0.2590534 ## ASL 1.0000000 -0.3541723 ## NoS -0.3541723 1.0000000 ## ## 変数編入基準 Pin: 0.05 ## 変数除去基準 Pout: 0.05 ## 編入候補変数: Type P : <0.001 ***** 編入されました ## ## ***** ステップ 1 ***** 編入変数: Type ## ## ***** 分類関数 ***** ## ## 1 2 偏F値 P値 ## Type -0.3775 -0.12302 1987.9 <0.001 ## 定数項 73.0960 7.76320 ## ウィルクスのΛ: 0.18458 ## 等価なＦ値:　　 1987.9 ## 自由度:　　　　 (1, 450.00) ## Ｐ値:　　　　　 <0.001 ## ## 除去候補変数: Type P : <0.001 ***** 除去されませんでした ## 編入候補変数: NoS P : <0.001 ***** 編入されました ## ## ***** ステップ 2 ***** 編入変数: NoS ## ## ***** 分類関数 ***** ## ## 1 2 偏F値 P値 ## Type -0.43779 -0.10464 1086.333 <0.001 ## NoS 0.40925 -0.12480 43.759 <0.001 ## 定数項 75.42732 7.98000 ## ウィルクスのΛ: 0.16819 ## 等価なＦ値:　　 1110.3 ## 自由度:　　　　 (2, 449.00) ## Ｐ値:　　　　　 <0.001 ## ## 除去候補変数: NoS P : <0.001 ***** 除去されませんでした ## 編入候補変数: AWL P : 0.00684 ***** 編入されました ## ## ***** ステップ 3 ***** 編入変数: AWL ## ## ***** 分類関数 ***** ## ## 1 2 偏F値 P値 ## Type -0.28127 0.042803 790.7280 < 0.001 ## NoS -0.86859 -1.328545 27.9443 < 0.001 ## AWL -92.71076 -87.335003 7.3827 0.00684 ## 定数項 294.54496 202.423625 ## ウィルクスのΛ: 0.16547 ## 等価なＦ値:　　 753.17 ## 自由度:　　　　 (3, 448.00) ## Ｐ値:　　　　　 <0.001 ## ## 除去候補変数: AWL P : 0.00684 ***** 除去されませんでした ## 編入候補変数: GI P : 0.196 ***** 編入されませんでした ## ## ===================== 結果 ===================== ## ## ***** 分類関数 ***** ## ## 1 2 偏F値 P値 ## Type -0.28127 0.042803 790.7280 < 0.001 ## NoS -0.86859 -1.328545 27.9443 < 0.001 ## AWL -92.71076 -87.335003 7.3827 0.00684 ## 定数項 294.54496 202.423625 ## ## ***** 判別関数 ***** ## ## 1 と 2 の判別 ## マハラノビスの汎距離: 6.15818 ## 理論的誤判別率:　　　 0.00104 ## ## 判別係数 標準化判別係数 ## Type 0.16204 17.04605 ## NoS -0.22998 -3.02903 ## AWL 2.68788 0.97799 ## 定数項 -46.06067 ## ## ***** 判別結果集計表 **** ## ## 判別された群 ## 実際の群 1 2 ## 1 69 2 ## 2 0 381 }} *三つの説明変数(Type, NoS, AWL)が選択された。 !!三つの説明変数(Type, NoS, AWL)を使った判別モデル {{pre DA.model5 <- lda(Lang ~ Type + NoS + AWL, data=all_indexes.df) DA.model5 ## Call: ## lda(Lang ~ Type + NoS + AWL, data = all_indexes.df) ## ## Prior probabilities of groups: ## 1 2 ## 0.1570796 0.8429204 ## ## Group means: ## Type NoS AWL ## 1 387.2676 45.66197 4.751333 ## 2 126.2073 22.06824 4.361718 ## ## Coefficients of linear discriminants: ## LD1 ## Type -0.02631280 ## NoS 0.03734493 ## AWL -0.43647342 }} !判別表 {{pre hyou <- table(all_indexes.df$Lang, predict(DA.model5)$class) hyou ## ## 1 2 ## 1 67 4 ## 2 0 381 }} !判別率 {{pre correct <- (hyou[1,1]+hyou[2,2])/sum(hyou) correct ## [1] 0.9911504 }} !!標準化判別係数が上位2つの説明変数(Type, NoS)を使った判別モデル {{pre A.model6 <- lda(Lang ~ Type + NoS, data=all_indexes.df) DA.model6 ## Call: ## lda(Lang ~ Type + NoS, data = all_indexes.df) ## ## Prior probabilities of groups: ## 1 2 ## 0.1570796 0.8429204 ## ## Group means: ## Type NoS ## 1 387.2676 45.66197 ## 2 126.2073 22.06824 ## ## Coefficients of linear discriminants: ## LD1 ## Type -0.02731629 ## NoS 0.04378828 }} !判別表 {{pre hyou <- table(all_indexes.df$Lang, predict(DA.model6)$class) hyou ## ## 1 2 ## 1 66 5 ## 2 0 381 }} !判別率 {{pre correct <- (hyou[1,1]+hyou[2,2])/sum(hyou) correct ## [1] 0.9889381 }} !グラフの作成 {{pre DA.model6 <- lda(Lang ~ Type + NoS , data=all_indexes.df) teisu <- apply(DA.model6$means %*% DA.model6$scaling, 2, mean) # 定数項の計算 plot(all_indexes.df$Type, all_indexes.df$NoS, col=c("blue", "red")[all_indexes.df$Lang], cex=1) xmin <- min(all_indexes.df$Type) # x軸の最小値 xmax <- max(all_indexes.df$Type) # x軸の最大値 ymin <- teisu/DA.model6$scaling[2] - (DA.model6$scaling[1]*xmin)/DA.model6$scaling[2] # xminの時のyの値の計算 ymax <- teisu/DA.model6$scaling[2] - (DA.model6$scaling[1]*xmax)/DA.model6$scaling[2] # xmaxの時のyの値の計算 lines(c(xmin,xmax),c(ymin,ymax), type="l", col="green", lwd=2) # 最小値の(x, y)座標と最大値の(x, y)座標を結ぶ直線 }} {{ref_image model6.png}}