復習を兼ねてデータの準備

NICERから、IDと「トピック」とCriterionスコア及び8つの言語指標を出力する

myNICERindex <- function(){
  
  # 各指標のベクトルを作っておいて、できたものをデータフレームにまとめる
  
  # ベクトルの初期化
  typeV  <- c()
  tokenV <- c()
  ttrV   <- c()
  giV    <- c()
  awlV   <- c()
  aslV   <- c()
  nosV   <- c()
  
  mattrV <- c()                                   # MATTR追加 以下同じ
  scoreV <- c()
  idV    <- c()
  topicV <- c()
  
  files <- list.files()
  
  for (i in files) {
    lines.tmp <- scan(i, what="char", sep="\n")
    body.tmp <- grep("^\\*\\w+:\t", lines.tmp, value=T)
    data.tmp <- gsub("^\\*\\w+:\t", "", body.tmp)
    data.tmp <- data.tmp[data.tmp != ""]
    tmp4 <- gsub("[[:punct:]]", " ", data.tmp) 
    tmp5 <- gsub("  +", " ", tmp4)
    tmp6 <- tolower(tmp5)
    tmp7 <- strsplit(tmp6, " ")
    tmp8 <- unlist(tmp7)
    token <- sort(tmp8)
    type <- unique(token)
    
    ttr <- length(type)/length(token)
    gi  <- length(type)/sqrt(length(token))
    tmp <- paste(token, collapse = "")
    awl <- nchar(tmp)/length(token)
    asl <- length(token)/length(data.tmp)
    nos <- length(body.tmp)                                # Number of Sentences
    
    #MATTR 追加
    numwords <- length(token)
    token <- c(token,token)
    ttrsum <- 0                                            # ttrsum の初期化
    mattr <- 0                                             # mattr の初期化
    for(i in 1:numwords){
      mado <- token[i:(99+i)]
      wttr <- length(unique(sort(mado)))/100 
      ttrsum <- ttrsum + wttr
    }
    mattr <-    ttrsum/numwords                         # mattrに代入
    mattrV   <- c(mattrV, mattr)                      # ベクトルデータとして保存
    
    #スコア 追加
    criterion.tmp <- grep("@Criterion", lines.tmp, value = T) # @Criterionの行を検索
    score <- gsub("@Criterion:\t", "", criterion.tmp)         # スコアのみに
    scoreV   <- c(scoreV , score)                             # ベクトルデータとして保存
    
    #ID 追加
    id.tmp <- grep("@Participants:", lines.tmp, value = T) # @Participantsの行を検索
    id <- gsub("@Participants:\t", "", id.tmp)         # IDのみに
    idV   <- c(idV , id)                             # ベクトルデータとして保存
 
    #Topic 追加
    topic.tmp <- grep("@Topic:", lines.tmp, value = T) # @Participantsの行を検索
    topic <- gsub("@Topic:\t", "", topic.tmp)         # IDのみに
    topicV   <- c(topicV , topic)                             # ベクトルデータとして保存
  
    
    # 各数値をベクトルに入れる
    typeV <- c(typeV, length(type))
    tokenV <- c(tokenV, length(token))
    ttrV   <- c(ttrV, ttr)
    giV    <- c(giV, gi)
    awlV   <- c(awlV, awl)
    aslV   <- c(aslV, asl)
    nosV   <- c(nosV, nos)
  

  }
  
 # 最後に全部をデータフレームにまとめる
 data.frame(idV, topicV, scoreV, typeV, tokenV, ttrV, giV, mattrV, awlV, aslV, nosV)

}

実行

母語話者データ

setwd("NICER1_3_2/NICER_NS")

ns_indexes.df <- myNICERindex()
head(ns_indexes.df )

「見出し」を付け替える:names() <- c()

names(ns_indexes.df ) <- c("ID", "Topic", "Score", "Type", "Token", "TTR", "GI", "MATTR", "AWL","ASL", "NoS")

head(ns_indexes.df )

学習者データ

setwd("NICER1_3_2/NICER_NNS")                    # ディレクトリーを変える NNS

jp_indexes.df <- myNICERindex()
names(jp_indexes.df ) <- c("ID", "Topic", "Score", "Type", "Token", "TTR", "GI", "MATTR", "AWL","ASL", "NoS")
head(jp_indexes.df )

学習者データと母語話者データの統合

学習者データのデータフレームと母語話者データのデータフレームの作成

  • jp_indexes.df と ns_indexes.df

nsとjpというカテゴリーをそれぞれのデータフレームに追加する

  • 統合した後、カテゴリーでデータを分けることができるように

  • 新しいカラムを追加:使ってない見出しを設定し、そこに入れたいものを代入

    • ns と jp は、言語の違いということで、L1とL2、Langという見出しにして、ns は 1 、jp は 2 を入れる。
jp_indexes.df$Lang <- 2

head(jp_indexes.df)
ns_indexes.df$Lang <- 1

head(ns_indexes.df)

二つのデータフレームを統合する:「縦に(row)」つなげる: rbind(データフレーム1, データフレーム2)

  • all_indexes.df
all_indexes.df <- rbind(jp_indexes.df, ns_indexes.df)

head(all_indexes.df)
tail(all_indexes.df)

データをテキストファイルに保存しておく

write.table(all_indexes.df, "all_indexes.df.txt")
all_indexes.df <- read.table("all_indexes.df.txt")

判別分析

head(all_indexes.df)
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 : num  2 2 2 2 2 2 2 2 2 2 ...

判別カテゴリーをファクター型に

all_indexes.df$Lang <- as.factor(all_indexes.df$Lang)
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

install.packages("klaR")
library(MASS)
library(klaR)

DA.result <- lda(Lang ~ Type + Token + MATTR + AWL + ASL + NoS, data=all_indexes.df, CV=T)
DA.result$class
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [186] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [223] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [260] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [297] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [334] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [371] 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1
## [408] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1
## [445] 1 1 1 1 1 1 1 1
## Levels: 1 2
head(DA.result)
## $class
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [186] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [223] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [260] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [297] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [334] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [371] 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1
## [408] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 2 1 1 1 1 1 1 1 1 1 1 1
## [445] 1 1 1 1 1 1 1 1
## Levels: 1 2
## 
## $posterior
##                1            2
## 1   6.384826e-10 1.000000e+00
## 2   4.255631e-08 1.000000e+00
## 3   3.935459e-09 1.000000e+00
## 4   4.963698e-09 1.000000e+00
## 5   8.399544e-07 9.999992e-01
## 6   4.582764e-10 1.000000e+00
## 7   2.646479e-08 1.000000e+00
## 8   1.565326e-11 1.000000e+00
## 9   3.181783e-11 1.000000e+00
## 10  3.681945e-11 1.000000e+00
## 11  4.187083e-06 9.999958e-01
## 12  2.669460e-06 9.999973e-01
## 13  7.324474e-11 1.000000e+00
## 14  5.294193e-10 1.000000e+00
## 15  3.518278e-10 1.000000e+00
## 16  3.523144e-06 9.999965e-01
## 17  1.737389e-10 1.000000e+00
## 18  6.440362e-11 1.000000e+00
## 19  1.277798e-07 9.999999e-01
## 20  1.272575e-05 9.999873e-01
## 21  6.679954e-09 1.000000e+00
## 22  4.915681e-11 1.000000e+00
## 23  3.876912e-11 1.000000e+00
## 24  3.774916e-10 1.000000e+00
## 25  3.100653e-12 1.000000e+00
## 26  2.310106e-07 9.999998e-01
## 27  9.938690e-09 1.000000e+00
## 28  9.198805e-08 9.999999e-01
## 29  1.302998e-07 9.999999e-01
## 30  1.332494e-10 1.000000e+00
## 31  1.439842e-09 1.000000e+00
## 32  1.537305e-11 1.000000e+00
## 33  1.540771e-12 1.000000e+00
## 34  2.164106e-10 1.000000e+00
## 35  5.421159e-07 9.999995e-01
## 36  7.986783e-11 1.000000e+00
## 37  2.149420e-08 1.000000e+00
## 38  5.988938e-12 1.000000e+00
## 39  7.236396e-11 1.000000e+00
## 40  3.211157e-08 1.000000e+00
## 41  2.584767e-12 1.000000e+00
## 42  1.915754e-06 9.999981e-01
## 43  9.189778e-07 9.999991e-01
## 44  3.758559e-12 1.000000e+00
## 45  4.457020e-05 9.999554e-01
## 46  1.366531e-08 1.000000e+00
## 47  1.193257e-10 1.000000e+00
## 48  2.512471e-07 9.999997e-01
## 49  3.203798e-08 1.000000e+00
## 50  1.272278e-10 1.000000e+00
## 51  1.937644e-09 1.000000e+00
## 52  1.128206e-10 1.000000e+00
## 53  1.517817e-12 1.000000e+00
## 54  2.449757e-07 9.999998e-01
## 55  7.028024e-12 1.000000e+00
## 56  2.524846e-12 1.000000e+00
## 57  2.056753e-06 9.999979e-01
## 58  2.095614e-10 1.000000e+00
## 59  7.590509e-12 1.000000e+00
## 60  1.338652e-08 1.000000e+00
## 61  4.752522e-11 1.000000e+00
## 62  5.007223e-08 9.999999e-01
## 63  8.526159e-11 1.000000e+00
## 64  6.886313e-10 1.000000e+00
## 65  3.805128e-05 9.999619e-01
## 66  4.612458e-11 1.000000e+00
## 67  3.104288e-10 1.000000e+00
## 68  1.386288e-10 1.000000e+00
## 69  1.017921e-07 9.999999e-01
## 70  1.192994e-10 1.000000e+00
## 71  1.530313e-09 1.000000e+00
## 72  7.092443e-07 9.999993e-01
## 73  1.393933e-11 1.000000e+00
## 74  2.024974e-11 1.000000e+00
## 75  1.778608e-08 1.000000e+00
## 76  1.130817e-08 1.000000e+00
## 77  4.975658e-09 1.000000e+00
## 78  4.094741e-09 1.000000e+00
## 79  2.451466e-09 1.000000e+00
## 80  2.819123e-12 1.000000e+00
## 81  3.039477e-12 1.000000e+00
## 82  1.581850e-10 1.000000e+00
## 83  9.603282e-11 1.000000e+00
## 84  1.613390e-04 9.998387e-01
## 85  2.518829e-09 1.000000e+00
## 86  6.975731e-11 1.000000e+00
## 87  1.789878e-07 9.999998e-01
## 88  2.017559e-09 1.000000e+00
## 89  3.227868e-11 1.000000e+00
## 90  2.050017e-08 1.000000e+00
## 91  2.487389e-08 1.000000e+00
## 92  2.271843e-11 1.000000e+00
## 93  6.618071e-11 1.000000e+00
## 94  3.625093e-12 1.000000e+00
## 95  3.306206e-10 1.000000e+00
## 96  5.579372e-09 1.000000e+00
## 97  1.850640e-09 1.000000e+00
## 98  3.800372e-11 1.000000e+00
## 99  1.725540e-10 1.000000e+00
## 100 3.047415e-08 1.000000e+00
## 101 1.517428e-10 1.000000e+00
## 102 3.150657e-08 1.000000e+00
## 103 2.060491e-07 9.999998e-01
## 104 3.130459e-08 1.000000e+00
## 105 8.680425e-09 1.000000e+00
## 106 7.351568e-11 1.000000e+00
## 107 3.068953e-10 1.000000e+00
## 108 1.042763e-10 1.000000e+00
## 109 4.168751e-08 1.000000e+00
## 110 3.344794e-08 1.000000e+00
## 111 3.310360e-09 1.000000e+00
## 112 8.327967e-10 1.000000e+00
## 113 1.046892e-11 1.000000e+00
## 114 1.568972e-09 1.000000e+00
## 115 1.170972e-08 1.000000e+00
## 116 5.338528e-10 1.000000e+00
## 117 4.643813e-08 1.000000e+00
## 118 6.164314e-08 9.999999e-01
## 119 4.418835e-08 1.000000e+00
## 120 2.200328e-09 1.000000e+00
## 121 5.173728e-11 1.000000e+00
## 122 1.536059e-09 1.000000e+00
## 123 3.046052e-10 1.000000e+00
## 124 2.912880e-07 9.999997e-01
## 125 1.038679e-09 1.000000e+00
## 126 3.801147e-08 1.000000e+00
## 127 4.628799e-08 1.000000e+00
## 128 5.225185e-10 1.000000e+00
## 129 1.765436e-09 1.000000e+00
## 130 8.271750e-11 1.000000e+00
## 131 6.426326e-09 1.000000e+00
## 132 7.850679e-11 1.000000e+00
## 133 3.554437e-11 1.000000e+00
## 134 3.276517e-09 1.000000e+00
## 135 8.560386e-08 9.999999e-01
## 136 1.804146e-07 9.999998e-01
## 137 9.138742e-10 1.000000e+00
## 138 1.978798e-09 1.000000e+00
## 139 7.244572e-12 1.000000e+00
## 140 3.974302e-13 1.000000e+00
## 141 3.843490e-09 1.000000e+00
## 142 1.251232e-10 1.000000e+00
## 143 3.017076e-10 1.000000e+00
## 144 1.519547e-09 1.000000e+00
## 145 4.150424e-09 1.000000e+00
## 146 2.573518e-06 9.999974e-01
## 147 9.507444e-09 1.000000e+00
## 148 1.132320e-08 1.000000e+00
## 149 2.254127e-09 1.000000e+00
## 150 4.665536e-06 9.999953e-01
## 151 8.821484e-04 9.991179e-01
## 152 3.031832e-12 1.000000e+00
## 153 1.703745e-06 9.999983e-01
## 154 6.262234e-06 9.999937e-01
## 155 3.422009e-05 9.999658e-01
## 156 4.684970e-08 1.000000e+00
## 157 1.934071e-07 9.999998e-01
## 158 1.056869e-02 9.894313e-01
## 159 6.450414e-12 1.000000e+00
## 160 1.017868e-08 1.000000e+00
## 161 3.598921e-05 9.999640e-01
## 162 3.085116e-07 9.999997e-01
## 163 4.657826e-04 9.995342e-01
## 164 1.408829e-07 9.999999e-01
## 165 5.682452e-10 1.000000e+00
## 166 6.502552e-11 1.000000e+00
## 167 2.924485e-07 9.999997e-01
## 168 5.341279e-08 9.999999e-01
## 169 9.024265e-08 9.999999e-01
## 170 2.160266e-07 9.999998e-01
## 171 1.430440e-09 1.000000e+00
## 172 2.882041e-07 9.999997e-01
## 173 2.183942e-08 1.000000e+00
## 174 1.515709e-05 9.999848e-01
## 175 1.433901e-10 1.000000e+00
## 176 7.001999e-10 1.000000e+00
## 177 6.635946e-09 1.000000e+00
## 178 3.847365e-09 1.000000e+00
## 179 4.979735e-06 9.999950e-01
## 180 4.305911e-05 9.999569e-01
## 181 1.180155e-14 1.000000e+00
## 182 2.077243e-05 9.999792e-01
## 183 1.145454e-03 9.988545e-01
## 184 3.243625e-07 9.999997e-01
## 185 6.943434e-06 9.999931e-01
## 186 1.416694e-06 9.999986e-01
## 187 4.553527e-10 1.000000e+00
## 188 6.323274e-07 9.999994e-01
## 189 7.523149e-09 1.000000e+00
## 190 2.566647e-09 1.000000e+00
## 191 2.259066e-05 9.999774e-01
## 192 1.349158e-09 1.000000e+00
## 193 1.008390e-11 1.000000e+00
## 194 2.077254e-04 9.997923e-01
## 195 2.925084e-12 1.000000e+00
## 196 3.738112e-11 1.000000e+00
## 197 2.132298e-06 9.999979e-01
## 198 5.639624e-11 1.000000e+00
## 199 4.963436e-11 1.000000e+00
## 200 6.130860e-09 1.000000e+00
## 201 9.804470e-08 9.999999e-01
## 202 4.963153e-07 9.999995e-01
## 203 7.947760e-07 9.999992e-01
## 204 4.283025e-11 1.000000e+00
## 205 5.423678e-12 1.000000e+00
## 206 3.480007e-09 1.000000e+00
## 207 3.038437e-08 1.000000e+00
## 208 3.989717e-09 1.000000e+00
## 209 4.330571e-08 1.000000e+00
## 210 4.747753e-11 1.000000e+00
## 211 5.168150e-12 1.000000e+00
## 212 3.423861e-09 1.000000e+00
## 213 1.776840e-08 1.000000e+00
## 214 2.496874e-10 1.000000e+00
## 215 1.211395e-11 1.000000e+00
## 216 5.978428e-08 9.999999e-01
## 217 2.223514e-08 1.000000e+00
## 218 5.994304e-09 1.000000e+00
## 219 2.598980e-07 9.999997e-01
## 220 2.397701e-10 1.000000e+00
## 221 1.765434e-15 1.000000e+00
## 222 6.819937e-12 1.000000e+00
## 223 2.640131e-09 1.000000e+00
## 224 2.759406e-11 1.000000e+00
## 225 8.763468e-07 9.999991e-01
## 226 1.402594e-10 1.000000e+00
## 227 1.186248e-11 1.000000e+00
## 228 1.253187e-07 9.999999e-01
## 229 9.522649e-11 1.000000e+00
## 230 3.956867e-09 1.000000e+00
## 231 6.412447e-08 9.999999e-01
## 232 8.672061e-12 1.000000e+00
## 233 1.119980e-08 1.000000e+00
## 234 1.477688e-10 1.000000e+00
## 235 4.425355e-12 1.000000e+00
## 236 5.343821e-11 1.000000e+00
## 237 5.858608e-10 1.000000e+00
## 238 3.275495e-10 1.000000e+00
## 239 7.639668e-12 1.000000e+00
## 240 4.786755e-11 1.000000e+00
## 241 3.272215e-10 1.000000e+00
## 242 1.007605e-11 1.000000e+00
## 243 2.140927e-12 1.000000e+00
## 244 1.671602e-11 1.000000e+00
## 245 6.807167e-12 1.000000e+00
## 246 2.424863e-12 1.000000e+00
## 247 4.095128e-11 1.000000e+00
## 248 1.043188e-10 1.000000e+00
## 249 3.830674e-11 1.000000e+00
## 250 1.470397e-11 1.000000e+00
## 251 1.627565e-10 1.000000e+00
## 252 8.213897e-10 1.000000e+00
## 253 7.839799e-11 1.000000e+00
## 254 2.467867e-12 1.000000e+00
## 255 3.627059e-11 1.000000e+00
## 256 1.045412e-09 1.000000e+00
## 257 4.169442e-09 1.000000e+00
## 258 2.999748e-08 1.000000e+00
## 259 2.650771e-12 1.000000e+00
## 260 1.283268e-10 1.000000e+00
## 261 5.204128e-10 1.000000e+00
## 262 9.799017e-12 1.000000e+00
## 263 1.966171e-12 1.000000e+00
## 264 2.814483e-11 1.000000e+00
## 265 4.103012e-08 1.000000e+00
## 266 1.803554e-09 1.000000e+00
## 267 2.235202e-12 1.000000e+00
## 268 7.974636e-12 1.000000e+00
## 269 1.197589e-13 1.000000e+00
## 270 1.307814e-11 1.000000e+00
## 271 4.388633e-11 1.000000e+00
## 272 3.087347e-10 1.000000e+00
## 273 1.233936e-10 1.000000e+00
## 274 1.587560e-10 1.000000e+00
## 275 4.354821e-10 1.000000e+00
## 276 5.018068e-10 1.000000e+00
## 277 2.476799e-11 1.000000e+00
## 278 1.722906e-10 1.000000e+00
## 279 1.354791e-12 1.000000e+00
## 280 2.718972e-12 1.000000e+00
## 281 2.681420e-10 1.000000e+00
## 282 4.879234e-10 1.000000e+00
## 283 2.098175e-14 1.000000e+00
## 284 7.494920e-12 1.000000e+00
## 285 4.585956e-11 1.000000e+00
## 286 1.669952e-07 9.999998e-01
## 287 5.118935e-14 1.000000e+00
## 288 5.825292e-10 1.000000e+00
## 289 1.459849e-11 1.000000e+00
## 290 2.687300e-10 1.000000e+00
## 291 2.663659e-12 1.000000e+00
## 292 1.874969e-10 1.000000e+00
## 293 1.258314e-13 1.000000e+00
## 294 6.639141e-12 1.000000e+00
## 295 2.956864e-10 1.000000e+00
## 296 7.591605e-11 1.000000e+00
## 297 1.052410e-10 1.000000e+00
## 298 3.736795e-11 1.000000e+00
## 299 6.036572e-14 1.000000e+00
## 300 2.096193e-08 1.000000e+00
## 301 3.437376e-11 1.000000e+00
## 302 1.034859e-07 9.999999e-01
## 303 6.453418e-11 1.000000e+00
## 304 6.149982e-07 9.999994e-01
## 305 1.382560e-13 1.000000e+00
## 306 1.607292e-11 1.000000e+00
## 307 1.822909e-07 9.999998e-01
## 308 2.290378e-12 1.000000e+00
## 309 4.525844e-12 1.000000e+00
## 310 1.315282e-09 1.000000e+00
## 311 1.045583e-09 1.000000e+00
## 312 1.390603e-08 1.000000e+00
## 313 9.261480e-10 1.000000e+00
## 314 7.862543e-11 1.000000e+00
## 315 1.254741e-11 1.000000e+00
## 316 5.257389e-08 9.999999e-01
## 317 5.854972e-10 1.000000e+00
## 318 1.490200e-07 9.999999e-01
## 319 5.093961e-10 1.000000e+00
## 320 7.795339e-12 1.000000e+00
## 321 7.253475e-11 1.000000e+00
## 322 2.079189e-07 9.999998e-01
## 323 3.959103e-09 1.000000e+00
## 324 2.936654e-10 1.000000e+00
## 325 5.985812e-09 1.000000e+00
## 326 2.606538e-11 1.000000e+00
## 327 3.684365e-05 9.999632e-01
## 328 1.032473e-10 1.000000e+00
## 329 3.365573e-10 1.000000e+00
## 330 2.807088e-08 1.000000e+00
## 331 1.006513e-10 1.000000e+00
## 332 1.320637e-09 1.000000e+00
## 333 2.984969e-07 9.999997e-01
## 334 2.880959e-11 1.000000e+00
## 335 1.345388e-10 1.000000e+00
## 336 2.913569e-10 1.000000e+00
## 337 2.162536e-11 1.000000e+00
## 338 2.423887e-10 1.000000e+00
## 339 2.868665e-10 1.000000e+00
## 340 5.815550e-13 1.000000e+00
## 341 1.087516e-08 1.000000e+00
## 342 1.854991e-10 1.000000e+00
## 343 2.587318e-12 1.000000e+00
## 344 5.741925e-13 1.000000e+00
## 345 8.655110e-12 1.000000e+00
## 346 1.028715e-10 1.000000e+00
## 347 6.275626e-09 1.000000e+00
## 348 1.581905e-10 1.000000e+00
## 349 8.132311e-10 1.000000e+00
## 350 1.625622e-11 1.000000e+00
## 351 5.645809e-12 1.000000e+00
## 352 1.217953e-09 1.000000e+00
## 353 4.719883e-12 1.000000e+00
## 354 4.736584e-11 1.000000e+00
## 355 7.414330e-12 1.000000e+00
## 356 9.585369e-11 1.000000e+00
## 357 4.592292e-09 1.000000e+00
## 358 6.243455e-12 1.000000e+00
## 359 4.594739e-10 1.000000e+00
## 360 1.805262e-10 1.000000e+00
## 361 7.745503e-11 1.000000e+00
## 362 8.075913e-12 1.000000e+00
## 363 3.989344e-07 9.999996e-01
## 364 1.749661e-11 1.000000e+00
## 365 7.748934e-09 1.000000e+00
## 366 4.056703e-11 1.000000e+00
## 367 9.032858e-12 1.000000e+00
## 368 7.160293e-11 1.000000e+00
## 369 2.429340e-10 1.000000e+00
## 370 2.904022e-11 1.000000e+00
## 371 6.546869e-13 1.000000e+00
## 372 5.645955e-08 9.999999e-01
## 373 1.998283e-11 1.000000e+00
## 374 1.397746e-11 1.000000e+00
## 375 2.081956e-11 1.000000e+00
## 376 4.401917e-13 1.000000e+00
## 377 2.908435e-10 1.000000e+00
## 378 1.943676e-09 1.000000e+00
## 379 9.892321e-12 1.000000e+00
## 380 1.649996e-12 1.000000e+00
## 381 5.556120e-12 1.000000e+00
## 382 9.999995e-01 5.000847e-07
## 383 9.999999e-01 5.296598e-08
## 384 1.000000e+00 6.429065e-10
## 385 9.999998e-01 2.421052e-07
## 386 1.000000e+00 8.554382e-10
## 387 9.999936e-01 6.364487e-06
## 388 9.241265e-01 7.587354e-02
## 389 9.999084e-01 9.159596e-05
## 390 9.999234e-01 7.664055e-05
## 391 9.999753e-01 2.469946e-05
## 392 9.999999e-01 9.079403e-08
## 393 3.437809e-01 6.562191e-01
## 394 4.198397e-02 9.580160e-01
## 395 9.999993e-01 6.754044e-07
## 396 1.000000e+00 3.492124e-09
## 397 1.000000e+00 1.801031e-09
## 398 9.996217e-01 3.782527e-04
## 399 1.000000e+00 8.688823e-09
## 400 1.000000e+00 6.447403e-47
## 401 1.000000e+00 8.107974e-13
## 402 1.000000e+00 4.109788e-11
## 403 1.000000e+00 1.863854e-10
## 404 1.000000e+00 1.705916e-09
## 405 1.000000e+00 6.579829e-09
## 406 9.999967e-01 3.286083e-06
## 407 1.000000e+00 5.716815e-20
## 408 1.000000e+00 1.498987e-10
## 409 1.000000e+00 9.521897e-16
## 410 9.999956e-01 4.392557e-06
## 411 1.000000e+00 2.954909e-13
## 412 9.613700e-01 3.863003e-02
## 413 9.999743e-01 2.565128e-05
## 414 9.999983e-01 1.658930e-06
## 415 9.999982e-01 1.761238e-06
## 416 1.000000e+00 5.716173e-11
## 417 9.995500e-01 4.500309e-04
## 418 9.999168e-01 8.317846e-05
## 419 1.000000e+00 9.018452e-11
## 420 1.000000e+00 1.001192e-09
## 421 1.000000e+00 6.601640e-15
## 422 1.000000e+00 4.559647e-13
## 423 9.999999e-01 1.207025e-07
## 424 9.997320e-01 2.680261e-04
## 425 2.609045e-01 7.390955e-01
## 426 9.874163e-01 1.258372e-02
## 427 1.000000e+00 3.844767e-10
## 428 9.999809e-01 1.912303e-05
## 429 9.988594e-01 1.140640e-03
## 430 1.000000e+00 3.239150e-12
## 431 8.456939e-01 1.543061e-01
## 432 1.000000e+00 5.697061e-10
## 433 2.059088e-02 9.794091e-01
## 434 1.000000e+00 2.837174e-09
## 435 9.999960e-01 3.957767e-06
## 436 1.000000e+00 1.835135e-12
## 437 9.668256e-01 3.317439e-02
## 438 9.999999e-01 7.890317e-08
## 439 9.999999e-01 5.340798e-08
## 440 1.000000e+00 6.716633e-09
## 441 9.999996e-01 3.822060e-07
## 442 1.000000e+00 3.396064e-09
## 443 9.999949e-01 5.062969e-06
## 444 1.000000e+00 9.716812e-10
## 445 1.000000e+00 2.343714e-12
## 446 1.000000e+00 3.237496e-12
## 447 9.999999e-01 5.697976e-08
## 448 9.924211e-01 7.578939e-03
## 449 1.000000e+00 1.458382e-13
## 450 1.000000e+00 9.572753e-14
## 451 1.000000e+00 4.767964e-09
## 452 1.000000e+00 6.307922e-18
## 
## $terms
## Lang ~ Type + Token + MATTR + AWL + ASL + NoS
## attr(,"variables")
## list(Lang, Type, Token, MATTR, AWL, ASL, NoS)
## attr(,"factors")
##       Type Token MATTR AWL ASL NoS
## Lang     0     0     0   0   0   0
## Type     1     0     0   0   0   0
## Token    0     1     0   0   0   0
## MATTR    0     0     1   0   0   0
## AWL      0     0     0   1   0   0
## ASL      0     0     0   0   1   0
## NoS      0     0     0   0   0   1
## attr(,"term.labels")
## [1] "Type"  "Token" "MATTR" "AWL"   "ASL"   "NoS"  
## attr(,"order")
## [1] 1 1 1 1 1 1
## attr(,"intercept")
## [1] 1
## attr(,"response")
## [1] 1
## attr(,".Environment")
## <environment: R_GlobalEnv>
## attr(,"predvars")
## list(Lang, Type, Token, MATTR, AWL, ASL, NoS)
## attr(,"dataClasses")
##      Lang      Type     Token     MATTR       AWL       ASL       NoS 
##  "factor" "numeric" "numeric" "numeric" "numeric" "numeric" "numeric" 
## 
## $call
## lda(formula = Lang ~ Type + Token + MATTR + AWL + ASL + NoS, 
##     data = all_indexes.df, CV = T)
## 
## $xlevels
## named list()
anyNA(all_indexes.df)
## [1] FALSE

欠損値がある

subset(all_indexes.df, is.na(Token))

判別具合を見る

DA.result2 <- lda(Lang ~ Type + Token + MATTR + AWL + ASL + NoS, data=all_indexes.df)

DA.result2
## 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

判別精度

data.frame(predict(DA.result2)$x, predict(DA.result2)$class, all_indexes.df$Lang)
table(all_indexes.df$Lang, predict(DA.result2)$class)
##    
##       1   2
##   1  67   4
##   2   0 381
plot(DA.result2)

partimat(Lang ~ Type + Token + MATTR + AWL + ASL + NoS, data=all_indexes.df, method="lda")

重要なもの二つにしてみる

DA.result3 <- lda(Lang ~  MATTR + AWL , data=all_indexes.df)
DA.result3
## Call:
## lda(Lang ~ MATTR + AWL, data = all_indexes.df)
## 
## Prior probabilities of groups:
##         1         2 
## 0.1570796 0.8429204 
## 
## Group means:
##       MATTR      AWL
## 1 0.4103297 4.751333
## 2 0.4712071 4.361718
## 
## Coefficients of linear discriminants:
##             LD1
## MATTR 12.394623
## AWL   -2.588162

TypeとToken

DA.TT <- lda(Lang ~  Type + Token , data=all_indexes.df)

DA.TT
## Call:
## lda(Lang ~ Type + Token, data = all_indexes.df)
## 
## Prior probabilities of groups:
##         1         2 
## 0.1570796 0.8429204 
## 
## Group means:
##       Type     Token
## 1 387.2676 1973.0986
## 2 126.2073  558.2415
## 
## Coefficients of linear discriminants:
##                LD1
## Type  -0.030407690
## Token  0.001464086
plot(DA.result3)

plot(DA.TT)

マトリックス

predict(DA.result3)$class
##   [1] 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [112] 2 2 2 2 2 2 1 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 1 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2 2 1 2 2 1 2 2 2 2 2
## [186] 2 2 2 2 2 2 2 2 2 2 2 2 1 1 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [223] 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2
## [260] 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [297] 2 2 2 1 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2 2 2 2 2
## [334] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 1 2 2 2 2 2 2
## [371] 2 2 2 2 2 2 2 2 2 2 2 2 2 1 1 2 2 2 2 2 1 1 1 2 2 1 1 1 2 1 2 1 2 1 1 2 2
## [408] 2 2 2 1 2 1 1 1 1 2 2 2 2 1 1 1 2 2 2 2 1 2 1 1 1 2 2 2 1 1 2 1 1 2 2 1 2
## [445] 2 2 1 1 2 1 2 1
## Levels: 1 2
all_indexes.df$Lang
##   [1] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [38] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
##  [75] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [112] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [149] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [186] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [223] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [260] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [297] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [334] 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2 2
## [371] 2 2 2 2 2 2 2 2 2 2 2 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [408] 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1 1
## [445] 1 1 1 1 1 1 1 1
## Levels: 1 2
table(all_indexes.df$Lang, predict(DA.result3)$class)
##    
##       1   2
##   1  33  38
##   2  24 357
table(all_indexes.df$Lang, predict(DA.TT)$class)
##    
##       1   2
##   1  67   4
##   2   0 381

判別精度

DA.result3$scaling
##             LD1
## MATTR 12.394623
## AWL   -2.588162
data.frame(predict(DA.result3)$x, predict(DA.result3)$class, all_indexes.df$Lang)
plot(DA.result3, type="both")

plot(DA.TT, type="both")

pairs(all_indexes.df[c("MATTR","AWL")], pch=22, bg=c("red", "blue"))

pairs(all_indexes.df[c("Type","Token")], pch=22, bg=c("red", "blue"))

plot(all_indexes.df[c("Type", "Token")], pch=22, bg=c("red", "blue"))

head(all_indexes.df)

グラフ

library(ggplot2)

ggplot(all_indexes.df, mapping = aes(x=MATTR, y=AWL, color=Lang)) +
  geom_point(stat="identity", position="identity") +
  geom_smooth(method=lm)
## `geom_smooth()` using formula 'y ~ x'

library(ggplot2)

ggplot(all_indexes.df, mapping = aes(x=Type, y=Token, color=Lang)) +
  geom_point(stat="identity", position="identity") +
  geom_smooth(method=lm)
## `geom_smooth()` using formula 'y ~ x'

ggplot(all_indexes.df, mapping = aes(x=MATTR, y=AWL, color=Lang)) +
  geom_point() +
  geom_smooth(method=lm)
## `geom_smooth()` using formula 'y ~ x'

DA.result3
## Call:
## lda(Lang ~ MATTR + AWL, data = all_indexes.df)
## 
## Prior probabilities of groups:
##         1         2 
## 0.1570796 0.8429204 
## 
## Group means:
##       MATTR      AWL
## 1 0.4103297 4.751333
## 2 0.4712071 4.361718
## 
## Coefficients of linear discriminants:
##             LD1
## MATTR 12.394623
## AWL   -2.588162

切片の計算

http://eau.uijin.com/advstats/discriminant.html

apply(fit\(means %*% fit\)scaling, 2, mean)

引数2で、列に対して計算

apply(DA.result3$means %*% DA.result3$scaling, 2, mean)
##       LD1 
## -6.329869
apply(DA.TT$means %*% DA.TT$scaling, 2, mean)
##       LD1 
## -5.953744
apply(DA.result3$means %*% DA.result3$scaling, 2, mean)
##       LD1 
## -6.329869
#apply(disc.model$means %*% disc.model$scaling, 2, mean)

データの事前確立に応じた重みづけを取る

行列演算なので、返り値がベクトルになるようにcをかませる

https://mikuhatsune.hatenadiary.com/entry/2021/02/12/165456

alpha <- c(DA.result3$prior %*% DA.result3$means %*% DA.result3$scaling)
alpha
## [1] -5.725321
alpha <- c(DA.TT$prior %*% DA.TT$means %*% DA.TT$scaling)
alpha
## [1] -3.94191
library(MASS)
plot(DA.result3)

boundary <- ggplot(data = all_indexes.df, aes(x = MATTR, y = AWL, color = Lang)) +
  geom_point()
  #geom_point(Lang = predict(DA.result3)$class, color = "red", breaks = c(1.5)) +
  #geom_point(size = 4, alpha = .5) +
#  ggtitle("Decision boundary") +
#  theme(legend.text = element_text(size = 10)) +
#  scale_colour_manual(name = 'Lang', values = all_indexes.df)
  
show(boundary)

a0 <- - apply(DA.result3$means %*% DA.result3$scaling,2,mean)
#a0 <- apply(DA.result3$means %*% DA.result3$scaling,2,mean)

# これが間違っている ↓
#x <- seq(min(all_indexes.df$MATTR), max(all_indexes.df$MATTR), length(all_indexes.df$MATTR))
x <- seq(min(all_indexes.df$MATTR), max(all_indexes.df$MATTR), 1)

y <- -DA.result3$scaling[1]/DA.result3$scaling[2]*x - a0/DA.result3$scaling[2]

mu <- apply(DA.result3$means, 2, mean)
ggplot(all_indexes.df)+
  geom_point(aes(MATTR, AWL, col=Lang))+
  geom_point(aes(mu[1], mu[2]), size=2) +
  theme(text=element_text(size=10)) +
  #labs(title="散布図", x="MATTR", y="AWL") +
  geom_line(aes(x, y))

 # geom_contour(aes(x, y, matrix(as.numeric(predict(DA.result3, expand.grid(x,y)$class, 300, 300 )))))

https://sugiura-ken.org/wiki/wiki.cgi/exp?page=%C8%BD%CA%CC%CA%AC%C0%CF

定数項の計算

teisu <- apply(DA.result3$means %*% DA.result3$scaling, 2, mean)
teisu
##       LD1 
## -6.329869
判別式の直線の求め方(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]

y = -teisu + DA.result3\(scaling[1]*all_indexes.df\)AWL + DA.result3\(scaling[2]*all_indexes.df\)MATTR

0 = -teisu + DA.result3\(scaling[1]*all_indexes.df\)AWL + DA.result3\(scaling[2]*all_indexes.df\)MATTR

all_indexes.df\(AWL = teisu/DA.result3\)scaling[1] - DA.result3\(scaling[2]*all_indexes.df\)MATTR/DA.result3$scaling[1]

yc = teisu/DA.result3\(scaling[1] - DA.result3\)scaling[2]*MATTR/DA.result3$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) #オプションをもとに戻す

plot(all_indexes.df$MATTR, all_indexes.df$AWL, col=c("blue", "red")[all_indexes.df$Lang], cex=1)

par(new=T)

xc <- seq(min(all_indexes.df$MATTR), max(all_indexes.df$MATTR), 0.01)
yc <- teisu/DA.result3$scaling[1]  - DA.result3$scaling[2]*xc/DA.result3$scaling[1]

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

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

★ 散布図と判別境界線の描写 2021-12-28 の成果

定数項の計算

teisu <- apply(DA.result3$means %*% DA.result3$scaling, 2, mean)
teisu
##       LD1 
## -6.329869

線のひき方を変える

最小値と最大値を結ぶ直線

plot(all_indexes.df$MATTR, all_indexes.df$AWL, col=c("blue", "red")[all_indexes.df$Lang], cex=1)

par(new=T)

xmin <- min(all_indexes.df$MATTR)  # x軸のMATTRの最小値
xmax <- max(all_indexes.df$MATTR)  # x軸のMATTRの最大値

ymin <- teisu/DA.result3$scaling[2]  - (DA.result3$scaling[1]*xmin)/DA.result3$scaling[2] # xminの時のyの値の計算
ymax <- teisu/DA.result3$scaling[2]  - (DA.result3$scaling[1]*xmax)/DA.result3$scaling[2] # xmaxの時のyの値の計算

lines(c(xmin,xmax),c(ymin,ymax), type="l", col="green", lwd=2) # 最小値の(x, y)座標と最大値の(x, y)座標を結ぶ直線

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

判別式

z = 切片 + 係数要因 + 係数要因

切片 -6.329869 MATTR 12.394623 AWL -2.588162

連立方程式 切片 + 係数要因 + 係数要因 = 0   分割する直線 Lang = 切片 + 係数要因 + 係数要因 線形判別関数

判別スコア = 切片 + 係数1要因x + 係数2要因y 判別スコアが、プラスかマイナスかで判別するように、「判別スコアが0になる」ようにする。

そのためには、切片がゼロになるようにする。 =切片の分だけマイナスして、y軸の始点をを0にする。=結果的に切片をマイナスするのと同じ。

0 = 切片 + 係数1要因x + 係数2要因y

0 = -(切片) + 係数1要因x + 係数2要因y 切片 = 係数1要因x + 係数2要因y

係数2要因y = -係数1要因x + 切片 y = -(係数1/係数2)x + 切片/係数2

AWL = -(12.394623/-2.588162)MATTR +(-6.329869/-2.588162)

y =

連立方程式を解く

Lang =

0 = -(-6.329869) + 12.394623MATTR -2.588162AWL

  • ここで、どうして切片にマイナスが付くかが不明

0 = 6.329869 + 12.394623x -2.588162y

2.588162y = 12.394623x +6.329869

y = (12.394623/2.588162)x + (6.329869/2.588162)

Type = alpha + Ax + By

y = -(alpha + Ax)/B

切片 -6.329869 MATTR 12.394623 AWL -2.588162

0 = -6 + 12M + -2A

A = -(-6 + 12M)/-2 = (-6 + 12M)/2 = -3 + 6M

散布図に直線を書き入れる

ggplot(all_indexes.df, mapping = aes(x=MATTR, y=AWL, color=Lang)) +
  geom_point() +
  #geom_smooth(method=lm) +
  geom_abline(AWL ~ (12.394623/2.588162)*MATTR + (6.329869/2.588162))
ggplot(all_indexes.df) +
  aes(x=MATTR, y=AWL, color=Lang) +
  geom_point() +
  #geom_smooth(method=lm) +
  #geom_smooth(method=lm, formula= y ~ 4.7*x - 2.4, color="red") +
  #geom_smooth(method=lm, formula= "AWL ~ 4.7*MATTR -2.4 ") +
  geom_abline(intercept=2.4, slope=4.7) 

Type Token

20.76906x -2692.403

ggplot(all_indexes.df) +
  aes(x=Type, y=Token, color=Lang) +
  geom_point() +
  #geom_smooth(method=lm) +
  #geom_smooth(method=lm, formula= y ~ 4.7*x - 2.4, color="red") +
  #geom_smooth(method=lm, formula= "AWL ~ 4.7*MATTR -2.4 ") +
  geom_abline(intercept=-2692.403, slope=20.76906) 

20.76906x -4066.526

ggplot(all_indexes.df) +
  aes(x=Type, y=Token, color=Lang) +
  geom_point() +
  #geom_smooth(method=lm) +
  #geom_smooth(method=lm, formula= y ~ 4.7*x - 2.4, color="red") +
  #geom_smooth(method=lm, formula= "AWL ~ 4.7*MATTR -2.4 ") +
  geom_abline(intercept=-4066.526, slope=20.76906) 

ggplot(all_indexes.df, mapping = aes(x=MATTR, y=AWL, color=Lang)) +
  geom_point() +
  geom_smooth(method=lm, formula=DA.result3$scaling)
## Warning: Computation failed in `stat_smooth()`:
## invalid formula

ggplotで書いてみる

long形式に

library(tidyverse)
## -- Attaching packages --------------------------------------- tidyverse 1.3.1 --
## v tibble  3.1.3     v dplyr   1.0.7
## v tidyr   1.1.4     v stringr 1.4.0
## v readr   2.0.1     v forcats 0.5.1
## v purrr   0.3.4
## -- Conflicts ------------------------------------------ tidyverse_conflicts() --
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
## x dplyr::select() masks MASS::select()
all_indexes.df.L <- all_indexes.df %>% gather(category, value, -ID, -Topic, -Lang)
head(all_indexes.df.L)

MATTRとAWLだけに

グラフ

mattr.awl <- all_indexes.df.L %>% filter(category==c("MATTR", "AWL"))
head(mattr.awl)
ggplot(mattr.awl) +
  geom_point(aes(aes(x=category, y=value, color=ID)))

- - - - - - - - - - - - - - - - - - - - 以下古い - - - - - - - - - - - - - - - - - - - -

ソースコードの読み込み

青木先生のsdis()

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

sdis(説明変数, 目的変数)

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 ...

必要な部分だけを抜き出して分析対象のデータセットを作る

disc.data <- data.frame(all_indexes.df$Lang, all_indexes.df$Type, all_indexes.df$Token, all_indexes.df$TTR, all_indexes.df$GI, all_indexes.df$MATTR, all_indexes.df$AWL, all_indexes.df$ASL, all_indexes.df$NoS)

head(disc.data)
names(disc.data) <- c("Lang", "Type", "Token", "TTR", "GI", "MATTR", "AWL", "ASL", "NoS")
str(disc.data)
## 'data.frame':    452 obs. of  9 variables:
##  $ Lang : Factor w/ 2 levels "1","2": 2 2 2 2 2 2 2 2 2 2 ...
##  $ 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 ...
sdis(disc.data[2:9], disc.data[1])
## 有効ケース数: 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
## 等価なF値:   1987.9
## 自由度:     (1, 450.00)
## P値:      <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
## 等価なF値:   1110.3
## 自由度:     (2, 449.00)
## P値:      <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
## 等価なF値:   753.17
## 自由度:     (3, 448.00)
## P値:      <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

結果を保存してグラフを描く

disc.result <- sdis(disc.data[2:9], disc.data[1])
## 有効ケース数: 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
## 等価なF値:   1987.9
## 自由度:     (1, 450.00)
## P値:      <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
## 等価なF値:   1110.3
## 自由度:     (2, 449.00)
## P値:      <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
## 等価なF値:   753.17
## 自由度:     (3, 448.00)
## P値:      <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
plot(disc.result, which="scatterplot", xpos="topright")

2次元散布図を書いてみる

               1          2    偏F値     P値
Type    -0.28143   0.042656 791.6104 < 0.001
NoS     -0.86598  -1.326043  28.0055 < 0.001
AWL    -92.70888 -87.336950   7.3713 0.00688

TypeとNoSを使ってみる

plot(disc.data$Type, disc.data$Nos)

# plot(disc.data$NoS, disc.data$Type, col= ifelse(disc.data$Lang==1, "red", "blue"))  # これで自動的に
  • 学習者と母語話者を色分けして
    • 学習者はLang==2, 母語話者はLang==1
  1. データのサブセットを作る
  2. グラフを重ねる
  • 軸の幅に注意 xlim=c(0,500), ylim=c(0,800)
discJ.data <- subset(disc.data, Lang==2)  # 学習者
discN.data <- subset(disc.data, Lang==1)  # 母語話者
plot(discJ.data$Type, discJ.data$NoS)

plot(discN.data$Type, discN.data$NoS)

plot(discJ.data$NoS, discJ.data$Type, xlab="", ylab="", xlim=c(0,180), ylim=c(0,800), col="blue")   # 学習者

par(new=T)

plot(discN.data$NoS, discN.data$Type, xlab="Nos", ylab="Type", xlim=c(0,180), ylim=c(0,800), col="red")   # 母語話者


語彙頻度上位語リストの作成

ファイルを選んで、上位10位まで

ディレクトリー内のすべてのファイルを対象に、指定した順位まで

連語表現の抽出

ファイルを選んで、2連語で、上位10位まで

ディレクトリー内のすべてのファイルを対象に、3連語で、指定した順位まで


スクリプトの保存と読み込み

パソコン内のスクリプト・ファイル

インターネット上のスクリプト・ファイル


出現頻度の検定:カイ自乗検定

頻度に差があるか: chisq:test()

可視化: mozaicplot()

どこに差があるか:残差分析

群馬大学の青木先生のサイト
   http://aoki2.si.gunma-u.ac.jp/R/
   
   度数に関する検定
   カイ二乗分布を使用する独立性の検定と残差分析
   
> source("http://aoki2.si.gunma-u.ac.jp/R/src/my-chisq-test.R", encoding="euc-jp")

   ★my-chisq-test.Rというファイル名だが、関数名はmy.chisq.test()

対数尤度比検定:G^2

http://aoki2.si.gunma-u.ac.jp/R/src/G2.R“, encoding=”euc-jp

サンプルサイズに関係ない効果量

2×2の場合

  • オッヅ比:Fisherの直接確率検定(正確確率検定): fisher.test()
  • 解釈の仕方:「1」が基準=確率に差はない。1より大きければ、分子の方の確率が高い。
> fisher.test(therefore.data)

        Fisher's Exact Test for Count Data

data:  therefore.data
p-value = 9.958e-06
alternative hypothesis: true odds ratio is not equal to 1
95 percent confidence interval:
 0.1021974 0.4526589
sample estimates:
odds ratio 
 0.2196899 

2x2以上の場合

  • クラメールのV(Cramer’s V)
  • 解釈の仕方:0から1の間
> install.packages("lsr", dependencies = T)

> library(lsr)
> cramersV(therefore.data)
[1] 0.3081308
> tmp.data <- c(38, 15, 53, 96)
> cramersV(tmp.data)
[1] 0.3378448
> tmp.data2 <- c(38, 15, 53, 956)
> cramersV(tmp.data2)
[1] 0.8674172

コーパス分析専用パッケージの利用

quanteda: Quantitative Analysis of Textual Data

http://sugiura-ken.org/wiki/wiki.cgi/exp?page=quanteda