terukunのブログ

terukunのブログ

統計解析・経済学・マーケティングなどの雑記帳として用いているブログです。更新頻度は不定期です。

Amebaでブログを始めよう!
テキストマイニングの分析指標の一つに優越度というものがあります。

今回はこの優越度の計算をRを用いて行うためのコードを紹介しようと思います。

そもそも優越度とは何なのか、簡潔に説明しましょう。

優越度というのは、
二つのキーワード間において定義される上下関係の抽出を
行うための指標で、例えば、

クーペ
SUV
クロカン
スポーツ
セダン
ミニバン
バン
ハッチバック
オープン

などのカテゴリに共通するものとして、
「自動車」という単語を発見するために使われたりします。


つまり、
新聞などのニュースや雑誌などのテキスト情報から、
自動車というカテゴリに属している単語として、
クーペ・SUV・クロカン・スポーツ・セダン・ミニバン・バン・ハッチバック・オープン
を定義していくのです。


実際の式の説明ですが、

まず文書を0-1の単語ベクトルにしたものとして、







としておきます。前者は単語iに関する単語ベクトルで後者は単語iの差集合に関する単語ベクトルを表しています。
式から明らかなように、前者のベクトルで1の要素は後者のベクトルで必ず0になります。

そして、優越度の数式は



となっています。

なお、このR(・,・)の箇所は



を表しており、単語ベクトル間の余弦となっています。


優越度の数式P(i,j)が意味するものは、
所与の文書集合の中において、単語iが単語jを優越するかどうかです。

P(i,j)は余弦に基づく値なので、その取りうる値域は限られています。
実際に、



の範囲となります。

そして、優越度がP(i,j) < 0 の時、
単語iは単語jを優越すると言います。

車の例で言うと、自動車がセダンを優越しているはずなので、この値が負値になる可能性があるのです。

以上が優越度の説明です。


以下では実際にRで回る優越度計算のコードを記しています。
50くらいの文書に対して、30~40分は計算にかかってしまいますが。

#Superiority
#RMeCabのインストールは必須となっております。
#MeCabをインストールしなければならないのは無論です。

library(RMeCab)
#ベクトルのノルムを計算するための関数
vecnorm <- function(x) {sqrt(sum(x*x))}

#文書行列の作成
res <- docMatrix("word_of_mouth_communication",pos = c("名詞"))
res <- res[ row.names(res) != "[[LESS-THAN-1]]", ]
res <- res[ row.names(res) != "[[TOTAL-TOKENS]]", ]
n <- nrow(res)
m <- ncol(res)

#プログレッシグバー表示のためのデータ
pb <- txtProgressBar(min = 1, max = n, style = 3)

#単語ベクトルの0-1データ化
for(i in 1:n){
  for(j in 1:m){
   if(res[i,j]>=1){
    res[i,j] <- 1
   }
  }
}

#補集合マトリックスの作成
resminusone <- matrix(1,n,m)-res

#Superiorityの計算
Superiority <- matrix(,nrow=n,ncol=n)
for(i in 1:n){
  for(j in 1:n){
  Relevancy_cal_01 <- sum(t(res[i,])*t(resminusone[j,])) / ( vecnorm(t(res[i,]))* vecnorm(t(resminusone[j,])))
  Relevancy_cal_02 <- sum(t(resminusone[i,])*t(res[j,])) / ( vecnorm(t(resminusone[i,]))* vecnorm(t(res[j,])))
  Superiority[j,i] <- acos(Relevancy_cal_01)-acos(Relevancy_cal_02)
  }
  setTxtProgressBar(pb, i)
}

#結果をCSVに出力
write.csv(Superiority,"Superiority.csv")
list <- res[,1]
write.csv(list,"list.csv")