Lecture10: 線形判別分析, 決定木, ランダムフォレスト
参照コード&データ
石田・小林(2013)『Rで学ぶ日本語テキストマイニング』
小林(2017)『Rによるやさしいテキストマイニング：機械学習編』
線形判別分析
####（石田・小林(2013)『Rで学ぶ日本語テキストマイニング』: p.146-152
作家データの読み込み
data1 <- read.delim("Lec10_data1.txt", row.names = 1, header = TRUE)データの確認
head(data1)
colnames(data1)
length(colnames(data1))
length(rownames(data1))データの概要
summary(data1)MASSパッケージの読み込み
library (MASS) 線形判別分析
lda.model <- lda(作者 ~ ., data = data1)
lda.model## Call:
## lda(作者 ~ ., data = data1)
##
## Prior probabilities of groups:
## 太宰治 芥川龍之介
## 0.5 0.5
##
## Group means:
## か が く し ず て
## 太宰治 0.6525080 2.678417 1.000287 1.7003246 0.5639713 7.449845
## 芥川龍之介 0.8936821 4.144038 0.277098 0.5041663 0.4065555 2.691739
## で と に は ば へ
## 太宰治 2.5381815 1.524926 2.519240 9.464232 0.6039739 0.1122260
## 芥川龍之介 0.8360013 2.911046 3.604787 4.921635 1.0630131 0.6053547
## も ら り れ
## 太宰治 3.507773 3.046492 1.703575 0.5010864
## 芥川龍之介 2.216960 4.284926 1.336640 0.1318495
##
## Coefficients of linear discriminants:
## LD1
## か -4.2377384
## が 3.9090605
## く -3.5219509
## し -1.0069004
## ず -4.9585492
## て 0.2500134
## で -2.9350605
## と -1.2377630
## に 2.2879268
## は -1.5029414
## ば 1.9974492
## へ -12.0567489
## も -2.0506138
## ら 3.4331053
## り 7.7088565
## れ 0.5375046分類
lda.pred <- predict(lda.model, data1)
lda.pred$class## [1] 芥川龍之介 芥川龍之介 芥川龍之介 芥川龍之介 芥川龍之介 芥川龍之介
## [7] 芥川龍之介 芥川龍之介 芥川龍之介 芥川龍之介 太宰治 太宰治
## [13] 太宰治 太宰治 太宰治 太宰治 太宰治 太宰治
## [19] 太宰治 太宰治
## Levels: 太宰治 芥川龍之介散布図
par(family="HiraMaruProN-W4")
plot(lda.pred$x,type="n")
text(lda.pred$x,labels=as.character(rownames(lda.pred$x))) 
クロス集計表
lda.tab <- table(data1$作者, lda.pred$class)
lda.tab##
## 太宰治 芥川龍之介
## 太宰治 10 0
## 芥川龍之介 0 10正判別率の計算
sum(diag(lda.tab)) / sum(lda.tab) *100## [1] 100線形判別分析の交差妥当化
CV: Cross Validation
lda.model.cv <- lda(作者 ~ ., data = data1, CV = TRUE)クロス集計表
lda.cv.tab <- table(data1$作者, lda.model.cv$class)
lda.cv.tab##
## 太宰治 芥川龍之介
## 太宰治 8 2
## 芥川龍之介 2 8誤判別作品
rownames(data1)[data1$"作者"!=lda.model.cv$class]## [1] "A_邪宗門" "A_羅生門" "D_狂言の神" "D_猿面冠者"正判別率の計算
sum(diag(lda.cv.tab)) / sum(lda.cv.tab) *100## [1] 80ランダムフォレスト
####（石田・小林(2013)『Rで学ぶ日本語テキストマイニング』: p.185-190
randomForestパッケージのインストール
install.packages("randomForest") randomForestパッケージの呼び出し
library(randomForest)## randomForest 4.6-14## Type rfNews() to see new features/changes/bug fixes.アクセントデータの読み込み
data2 <- read.delim("Lec10_data2.txt", header = TRUE)データの確認
head(data2)
dim(data2)疑似乱数の種の設定
set.seed(5) 学習データと評価データを作成
n <- sample(1:258, 158)
train <- data2[n, ]
test <- data2[-n, ] 疑似乱数の種の設定
set.seed(5) ランダムフォレストによる判別モデル
rf.model <- randomForest(アクセント ~ ., ntree = 1000, mtry = 2,
proximity = TRUE, data = train)
rf.model##
## Call:
## randomForest(formula = アクセント ~ ., data = train, ntree = 1000, mtry = 2, proximity = TRUE)
## Type of random forest: classification
## Number of trees: 1000
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 31.01%
## Confusion matrix:
## 中高型 平板型 頭高型 class.error
## 中高型 75 2 18 0.2105263
## 平板型 3 0 1 1.0000000
## 頭高型 25 0 34 0.4237288plot(rf.model)
説明変数の寄与度
par(family="HiraMaruProN-W4")
varImpPlot(rf.model) 
多次元尺度法による視覚化
MDSplot(rf.model, train$アクセント,
pch = as.numeric(train$アクセント))
legend("topleft", legend = unique(train$アクセント), col=c("blue","red","green"),pch = as.numeric(unique(train$アクセント)))モデルによるテストデータの分類
rf.pred <- predict(rf.model, test)クロス集計表
rf.tab <- table(test$アクセント, rf.pred)
rf.tab## rf.pred
## 中高型 平板型 頭高型
## 中高型 50 1 8
## 平板型 1 0 3
## 頭高型 7 1 29正判別率の計算
sum(diag(rf.tab)) / sum(rf.tab) *100## [1] 79日本語作文データ(高頻度)
作文データ(高頻度)の読み込み
data3 <- read.delim("Lec10_data3.txt", row.names = 1, header = TRUE)データの確認
head(data3)
colnames(data3)
#length(colnames(data3))データの概要
summary(data3)高頻度 & 学習者/母語話者
線形判別分析
tmpData=data3[-2]
head(tmpData)## NS の に が て は で を と た も し こと ない な する 私 ある
## E01_NS_M NS 44 51 52 58 43 47 40 48 27 25 29 30 19 15 8 3 6
## E02_NNS_F NNS 69 64 52 38 48 34 38 46 19 24 20 14 9 9 13 5 7
## E03_NS_M NS 86 59 56 47 47 52 26 37 18 16 23 19 6 9 9 0 23
## E04_NS_F NS 73 51 50 37 40 34 31 36 12 23 22 22 15 27 17 3 10
## E05_NNS_F NNS 135 118 75 83 75 68 82 64 72 43 41 26 11 20 21 27 14
## E06_NNS_M NNS 67 43 34 44 39 42 24 32 11 27 19 13 14 12 7 12 4
## いう ます いる
## E01_NS_M 13 18 19
## E02_NNS_F 15 28 7
## E03_NS_M 9 0 12
## E04_NS_F 9 0 9
## E05_NNS_F 20 39 16
## E06_NNS_M 6 17 13lda.model <- lda(NS ~ ., data = tmpData)## Warning in lda.default(x, grouping, ...): variables are collinearlda.model## Call:
## lda(NS ~ ., data = tmpData)
##
## Prior probabilities of groups:
## NNS NS
## 0.5 0.5
##
## Group means:
## の に が て は で を と た も し こと ない な
## NNS 77.5 56.3 45.8 45.4 45.5 37.1 44.3 33.8 39.7 23.8 21.2 15.8 10.5 11.4
## NS 65.2 58.5 45.0 45.3 40.1 40.5 32.6 43.0 34.4 25.1 23.6 18.4 14.5 12.0
## する 私 ある いう ます いる
## NNS 10.6 13.6 7.8 8.8 15.0 8.4
## NS 9.7 6.3 11.4 9.8 3.5 8.9
##
## Coefficients of linear discriminants:
## LD1
## の -0.078241933
## に 0.082495552
## が 0.096483880
## て 0.140949463
## は -0.035978829
## で -0.002461168
## を -0.087318867
## と -0.020549925
## た -0.009531286
## も -0.090414781
## し 0.251636659
## こと -0.245433907
## ない 0.044600541
## な 0.161854193
## する -0.038209202
## 私 -0.051621217
## ある 0.026131439
## いう 0.041137789
## ます -0.169964811
## いる -0.080774521分類
lda.pred <- predict(lda.model, tmpData)
lda.pred$class## [1] NS NNS NS NS NNS NNS NS NNS NS NNS NNS NNS NS NNS NS NS NS
## [18] NNS NNS NS
## Levels: NNS NS散布図
par(family="HiraMaruProN-W4")
plot(lda.pred$x,type="n")
text(lda.pred$x,labels=as.character(rownames(lda.pred$x))) 
クロス集計表
lda.tab <- table(data3$NS, lda.pred$class)
lda.tab##
## NNS NS
## NNS 10 0
## NS 0 10正判別率の計算
sum(diag(lda.tab)) / sum(lda.tab) *100## [1] 100線形判別分析の交差妥当化
CV: Cross Validation
lda.model.cv <- lda(NS ~ ., data = tmpData, CV = TRUE)## Warning in lda.default(x, grouping, ...): variables are collinearクロス集計表
lda.cv.tab <- table(data3$NS, lda.model.cv$class)
lda.cv.tab##
## NNS NS
## NNS 6 4
## NS 3 7誤判別作品
rownames(data3)[data3$"NS"!=lda.model.cv$class]## [1] "E02_NNS_F" "E03_NS_M" "E06_NNS_M" "E07_NS_F" "E08_NNS_M" "H02_NNS_M"
## [7] "H06_NS_F"正判別率の計算
sum(diag(lda.cv.tab)) / sum(lda.cv.tab) *100## [1] 65高頻度 & 性別
線形判別分析
tmpData=data3[-1]
head(tmpData)## SEX の に が て は で を と た も し こと ない な する 私 ある
## E01_NS_M M 44 51 52 58 43 47 40 48 27 25 29 30 19 15 8 3 6
## E02_NNS_F F 69 64 52 38 48 34 38 46 19 24 20 14 9 9 13 5 7
## E03_NS_M M 86 59 56 47 47 52 26 37 18 16 23 19 6 9 9 0 23
## E04_NS_F F 73 51 50 37 40 34 31 36 12 23 22 22 15 27 17 3 10
## E05_NNS_F F 135 118 75 83 75 68 82 64 72 43 41 26 11 20 21 27 14
## E06_NNS_M M 67 43 34 44 39 42 24 32 11 27 19 13 14 12 7 12 4
## いう ます いる
## E01_NS_M 13 18 19
## E02_NNS_F 15 28 7
## E03_NS_M 9 0 12
## E04_NS_F 9 0 9
## E05_NNS_F 20 39 16
## E06_NNS_M 6 17 13lda.model <- lda(SEX ~ ., data = tmpData)## Warning in lda.default(x, grouping, ...): variables are collinearlda.model## Call:
## lda(SEX ~ ., data = tmpData)
##
## Prior probabilities of groups:
## F M
## 0.55 0.45
##
## Group means:
## の に が て は で を と
## F 74.27273 60.09091 45.63636 47.18182 42.72727 37.27273 38.18182 43.18182
## M 67.77778 54.11111 45.11111 43.11111 42.88889 40.66667 38.77778 32.55556
## た も し こと ない な する
## F 36.63636 22.90909 22.18182 15.81818 11.90909 12.09091 11.727273
## M 37.55556 26.33333 22.66667 18.66667 13.22222 11.22222 8.222222
## 私 ある いう ます いる
## F 10.363636 8.00000 10.181818 11.09091 8.000000
## M 9.444444 11.55556 8.222222 7.00000 9.444444
##
## Coefficients of linear discriminants:
## LD1
## の -0.043000109
## に 0.016763876
## が 0.142433658
## て 0.164562918
## は 0.234173649
## で -0.056564097
## を -0.075510407
## と -0.351155921
## た -0.009587213
## も 0.023044949
## し 0.273406395
## こと -0.292440275
## ない 0.328571476
## な 0.183680508
## する -0.702214570
## 私 -0.170120881
## ある 0.222096866
## いう -0.163433504
## ます 0.109134387
## いる -0.082539755分類
lda.pred <- predict(lda.model, tmpData)
lda.pred$class## [1] M F M F F M F M F F F M F M M F F M F M
## Levels: F M散布図
par(family="HiraMaruProN-W4")
plot(lda.pred$x,type="n")
text(lda.pred$x,labels=as.character(rownames(lda.pred$x))) 
クロス集計表
lda.tab <- table(data3$SEX, lda.pred$class)
lda.tab##
## F M
## F 11 0
## M 0 9正判別率の計算
sum(diag(lda.tab)) / sum(lda.tab) *100## [1] 100日本語作文データ(読点共起)
作文データ(読点共起)の読み込み
data4 <- read.delim("Lec10_data4.txt", row.names = 1, header = TRUE)データの確認
head(data4)
colnames(data4)
length(colnames(data4))データの概要
summary(data4)学習者/母語話者
線形判別分析
tmpData=data4[-2]
head(tmpData)## NS て が は の た に を と も し こと ます ある まし ない
## E01_NS_M NS 58 52 43 44 27 51 40 48 25 29 30 18 6 6 19
## E02_NNS_F NNS 38 52 48 69 19 64 38 46 24 20 14 28 7 10 9
## E03_NS_M NS 47 56 47 86 18 59 26 37 16 23 19 0 23 0 6
## E04_NS_F NS 37 50 40 73 12 51 31 36 23 22 22 0 10 0 15
## E05_NNS_F NNS 83 75 75 135 72 118 82 64 43 41 26 39 14 33 11
## E06_NNS_M NNS 44 34 39 67 11 43 24 32 27 19 13 17 4 1 14
## です か
## E01_NS_M 10 8
## E02_NNS_F 8 4
## E03_NS_M 0 4
## E04_NS_F 0 7
## E05_NNS_F 17 7
## E06_NNS_M 9 11lda.model <- lda(NS ~ ., data = tmpData)
lda.model## Call:
## lda(NS ~ ., data = tmpData)
##
## Prior probabilities of groups:
## NNS NS
## 0.5 0.5
##
## Group means:
## て が は の た に を と も し こと ます ある まし
## NNS 45.4 45.8 45.5 77.5 39.7 56.3 44.3 33.8 23.8 21.2 15.8 15.0 7.8 12.5
## NS 45.3 45.0 40.1 65.2 34.4 58.5 32.6 43.0 25.1 23.6 18.4 3.5 11.4 2.4
## ない です か
## NNS 10.5 10.0 7.8
## NS 14.5 3.4 7.4
##
## Coefficients of linear discriminants:
## LD1
## て 0.07320152
## が 0.05471302
## は 0.02647441
## の -0.12570205
## た -0.06456523
## に 0.08774319
## を 0.32657572
## と 0.44181058
## も -0.12807165
## し 0.27794399
## こと 0.10386995
## ます -0.50594000
## ある -0.36810004
## まし -0.77409412
## ない -0.86737106
## です 0.02923564
## か 0.64921623分類
lda.pred <- predict(lda.model, tmpData)
lda.pred$class## [1] NS NNS NS NS NNS NNS NS NNS NS NNS NNS NNS NS NNS NS NS NS
## [18] NNS NNS NS
## Levels: NNS NS散布図
par(family="HiraMaruProN-W4")
plot(lda.pred$x,type="n")
text(lda.pred$x,labels=as.character(rownames(lda.pred$x))) 
クロス集計表
lda.tab <- table(data4$NS, lda.pred$class)
lda.tab##
## NNS NS
## NNS 10 0
## NS 0 10正判別率の計算
sum(diag(lda.tab)) / sum(lda.tab) *100## [1] 100線形判別分析の交差妥当化
CV: Cross Validation
lda.model.cv <- lda(NS ~ ., data = tmpData, CV = TRUE)クロス集計表
lda.cv.tab <- table(data4$NS, lda.model.cv$class)
lda.cv.tab##
## NNS NS
## NNS 6 4
## NS 2 8誤判別作品
rownames(data4)[data4$"NS"!=lda.model.cv$class]## [1] "E02_NNS_F" "E08_NNS_M" "H01_NNS_F" "H03_NS_F" "H06_NS_F" "H08_NNS_M"正判別率の計算
sum(diag(lda.cv.tab)) / sum(lda.cv.tab) *100## [1] 70ランダムフォレストによる判別モデル
tmpData=data4[-2]
head(tmpData)## NS て が は の た に を と も し こと ます ある まし ない
## E01_NS_M NS 58 52 43 44 27 51 40 48 25 29 30 18 6 6 19
## E02_NNS_F NNS 38 52 48 69 19 64 38 46 24 20 14 28 7 10 9
## E03_NS_M NS 47 56 47 86 18 59 26 37 16 23 19 0 23 0 6
## E04_NS_F NS 37 50 40 73 12 51 31 36 23 22 22 0 10 0 15
## E05_NNS_F NNS 83 75 75 135 72 118 82 64 43 41 26 39 14 33 11
## E06_NNS_M NNS 44 34 39 67 11 43 24 32 27 19 13 17 4 1 14
## です か
## E01_NS_M 10 8
## E02_NNS_F 8 4
## E03_NS_M 0 4
## E04_NS_F 0 7
## E05_NNS_F 17 7
## E06_NNS_M 9 11疑似乱数の種の設定
set.seed(5) rf.model <- randomForest(NS ~ ., ntree = 1000, mtry = 2,
proximity = TRUE, data = tmpData)
rf.model##
## Call:
## randomForest(formula = NS ~ ., data = tmpData, ntree = 1000, mtry = 2, proximity = TRUE)
## Type of random forest: classification
## Number of trees: 1000
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 30%
## Confusion matrix:
## NNS NS class.error
## NNS 7 3 0.3
## NS 3 7 0.3説明変数の寄与度
par(family="HiraMaruProN-W4")
varImpPlot(rf.model) 
ランダムフォレストによる判別モデル(性別)
tmpData=data4[-1]
head(tmpData)## SEX て が は の た に を と も し こと ます ある まし ない
## E01_NS_M M 58 52 43 44 27 51 40 48 25 29 30 18 6 6 19
## E02_NNS_F F 38 52 48 69 19 64 38 46 24 20 14 28 7 10 9
## E03_NS_M M 47 56 47 86 18 59 26 37 16 23 19 0 23 0 6
## E04_NS_F F 37 50 40 73 12 51 31 36 23 22 22 0 10 0 15
## E05_NNS_F F 83 75 75 135 72 118 82 64 43 41 26 39 14 33 11
## E06_NNS_M M 44 34 39 67 11 43 24 32 27 19 13 17 4 1 14
## です か
## E01_NS_M 10 8
## E02_NNS_F 8 4
## E03_NS_M 0 4
## E04_NS_F 0 7
## E05_NNS_F 17 7
## E06_NNS_M 9 11rf.model <- randomForest(SEX ~ ., ntree = 1000, mtry = 2,
proximity = TRUE, data = tmpData)
rf.model##
## Call:
## randomForest(formula = SEX ~ ., data = tmpData, ntree = 1000, mtry = 2, proximity = TRUE)
## Type of random forest: classification
## Number of trees: 1000
## No. of variables tried at each split: 2
##
## OOB estimate of error rate: 60%
## Confusion matrix:
## F M class.error
## F 7 4 0.3636364
## M 8 1 0.8888889説明変数の寄与度
par(family="HiraMaruProN-W4")
varImpPlot(rf.model) 