トランプ大統領と金正恩氏の類似度を潜在的意味解析で判定する その２
前回の記事では、wikipediaから各国の大統領の説明を取得しました。
今回は、このデータを使って潜在的意味解析を行い、トランプ大統領と金正恩氏の類似度を判定していきたいと思います。
以下の手順3からの再開です。
３．潜在的意味解析で各指導者を潜在的空間に射影
まず、文書-単語行列を作成するために、RMeCabパッケージを使用できるようにします。
RMeCabのインストールは以下のページなどを参考にしてください。
注意点としては、MeCabそのものもインストールを忘れないようにしてください。 RMeCabパッケージだけインストールして使用しようとすると、RStudioがエラー落ちしてしまいます。
さて、RMeCabが使えるようになったら、以下のコードで各指導者の文書-単語行列を作成します。
### 3. 潜在的意味解析を実行
# パッケージの読み込み
library("RMeCab")
## 各指導者の説明文から単語-文書行列を作成する
# 説明文が入ったファイルのあるディレクトリを指定
path.dir <- "./desc"
# 単語カウントの最低出現回数を指定
minF <- 2
# 単語-文書行列の作成(名詞と動詞と形容詞のみ使用)
# 重みとしてtf-idfを用い，正規化した値を出力する
docterm <- docMatrix(path.dir, minFreq=minF,
pos = c("名詞", "形容詞"), weight = "tf*idf*norm")
# 先頭2行を削除
docterm.cut <- docterm[-(1:2),]
# minF個以上の文書にある語句のみピックアップ
docterm.select <- docterm.cut[which(apply(docterm.cut, 1, function(x) sum(x > 0) ) >= minF), ]
docMatrix関数でファイルの格納されたフォルダのパスを指定することで、文書-単語行列が生成されます。pos引数で使用する品詞を選択できるのですが、今回は名詞と形容詞のみを使用することとします。
また、weight引数で単語の重み付けのオプションを指定できます。今回はTF-IDFと正規化を指定しています。
TF-IDFは文書内での出現頻度と全体での出現頻度の割合を用いて、全体ではあまり出現しないが、特定の文書にだけ頻出する語句の重みを高くする手法です。これにより、文書をより特徴付ける単語の数値を大きくすることができます。
さて、得られた単語-文書行列の次元と、マトリクスの一部を確認してみましょう。
# 次元の確認 dim(docterm.select # いくつか要素のの確認 print(docterm.select[1:10, 1:2])
> dim(docterm.select)
[1] 2341 273
> print(docterm.select[1:10, 1:2])
docs
terms アイスランド 首相 ビャルニ・ベネディクトソン.txt アイスランド 大統領 グズニ・ヨハンネソン.txt
こと 0.06853151 0.03073494
回復 0.18593731 0.00000000
獲得 0.13186948 0.00000000
議席 0.20001793 0.00000000
月 0.09031433 0.01620163
後 0.09847178 0.00000000
首相 0.09794949 0.00000000
進歩 0.36285404 0.00000000
政権 0.08484629 0.00000000
選挙 0.12390810 0.01852339
273個の文書に対し、2341種類の単語が存在していることがわかります。 また、各文書に対して単語が関連付けられていることが確認できます。「こと」や「月」などのどの文書にも含まれそうな単語が入っていますが、TF-IDFの効果もあり、重みは小さめになっていますね。
それでは、この文書-単語行列をSVDで低ランク近似しましょう。
## svdによる低ランク近似を実行 # 特異値の累積和が何割にいくまでを残すかのパラメータ d.base <- 0.5 # svdを実行 svd.docterm <- svd(docterm.select) # 低ランク近似 index <- which(cumsum(svd.docterm$d / sum(svd.docterm$d)) <= d.base) svd.docterm.low <- NULL svd.docterm.low$u <- svd.docterm$u[, index] svd.docterm.low$v <- svd.docterm$v[, index] svd.docterm.low$d <- svd.docterm$d[index] rownames(svd.docterm.low$u) <- rownames(docterm.select) rownames(svd.docterm.low$v) <- colnames(docterm.select)
SVDによる低ランク近似では、特異値の大きさが擬似的に潜在トピックの重要度を表すため、特異値の低いものは価値の低い潜在トピックとし、行列から取り除きます。 ここでは、どれくらいまで次元を落とすかという基準に、特異値の累積和が特異値全体の何割に到達するまでを残すかという基準を用います。
この値はハイパーパラメータになるため、本来は最適化すべき項目ですが、取り合えず0.5でやってみました。
では、低ランク近似後の行列の次元を確認してみましょう。
# 次元の確認 dim(svd.docterm.low$v)
> dim(svd.docterm.low$v) [1] 273 82
2341次元あった単語ベクトルが、82次元まで削減できていますね。
では、この低ランク行列を保存して、余計な変数を削除しておきましょう。
# 低ランク行列の保存 save(svd.docterm.low, file="./svd_docterm_low.Rdata") # 要らない変数を削除 rm(list=ls()) gc(); gc();
４．トランプ大統領と金正恩氏の類似度を判定する
ではついに！本題のトランプ大統領と金正恩氏の類似度を判定して見ましょう！
まずは、任意の2文書の全ての組み合わせでcosine類似度を計算します。
### 4. トランプ大統領と金正恩総書記の類似度を計算する
# 低ランク行列の読み込み
load("./svd_docterm_low.Rdata")
# cosine類似度の計算
mat.v <- t(svd.docterm.low$v)
matrix.cos <- apply(mat.v, 2, function(x){
apply(mat.v, 2, function(y){
crossprod(x, y) / (sqrt(crossprod(x) * crossprod(y)))
})
})
diag(matrix.cos) <- NaN
これで、任意の組の類似度が得られるようになりました。
では、トランプ大統領と金正恩氏の類似度を出力してみましょう！
# トランプ大統領の番号を取得 index.trump <- which(rownames(svd.docterm.low$v) == "アメリカ合衆国 大統領 ドナルド・トランプ.txt") # 金正恩総書記の番号を取得 index.kim <- which(rownames(svd.docterm.low$v) == "北朝鮮 朝鮮労働党委員長 金正恩.txt") # トランプ大統領と金正恩総書記の類似度を出力 cat(matrix.cos[index.trump, index.kim])
> cat(matrix.cos[index.trump, index.kim]) 0.05124007
んー、微妙ですね。
似ていない場合はマイナスの値をとるため、似ていないこともない、といったところでしょうか……
数値だけだとよくわからないので、トランプ類似度偏差値を求めてみます。
# トランプ大統領の類似度偏差値を計算 cos.trump <- matrix.cos[index.trump, ] dev.trump <- (cos.trump - mean(cos.trump[-index.trump])) / sd(cos.trump[-index.trump]) * 10 + 50 # 金正恩総書記のトランプ偏差値を表示 print(dev.trump[index.kim]) # 金正恩総書記のトランプ順位の表示 trump.order <- dev.trump[order(-dev.trump)] which(names(trump.order) == "北朝鮮 朝鮮労働党委員長 金正恩.txt")
> print(dev.trump[index.kim])
北朝鮮 朝鮮労働党委員長 金正恩.txt
53.88065
> which(names(trump.order) == "北朝鮮 朝鮮労働党委員長 金正恩.txt")
[1] 58
偏差値53.88……。とっても微妙ですね。
順位は273人中58位。悪くはないですが……期待したほどではない結果です。
では、トランプ大統領に最も似た指導者はいったい誰なのでしょうか？出力してみましょう。
# トランプ偏差値上位10人表示 print(trump.order[1:10])
> print(trump.order[1:10])
フィリピン 大統領 ロドリゴ・ドゥテルテ.txt パラグアイ 大統領 オラシオ・カルテス.txt
129.29781 94.31164
韓国 大統領 文在寅.txt ボツワナ 大統領 イアン・カーマ.txt
88.77724 84.07969
ベネズエラ 大統領 ニコラス・マドゥロ.txt キプロス 大統領 ニコス・アナスタシアディス.txt
77.19171 76.18902
バチカン 教皇 フランシスコ.txt 日本 内閣総理大臣 安倍晋三.txt
73.40518 73.26178
ジンバブエ 大統領 ロバート・ムガベ.txt カナダ 首相 ジャスティン・トルドー.txt
72.60202 71.23118
なんと……類似度1位はフィリピンのドゥテルテ大統領で、なんとその偏差値129！！
大学受験とかで考えたらとんでもない化け物ですね！
そんなに似ているのか……とドゥテルテ大統領のwikipediaページを見てみると、以下のような記述がありました。
選挙戦中は、同時期に進行していたアメリカ大統領選挙に立候補する共和党候補者を選出する予備選挙で過激な発言を行う人物として注目されていた共和党のドナルド・トランプになぞらえ、「フィリピンのトランプ」とも揶揄された。
まんま記述があるじゃないですか！
おそらく、この「トランプ」という単語とか、「大統領」という単語などが共通しているため、類似度が高くなったようですね。
それぞれの文書を特徴付ける上位10単語を確認してみましょう。
## 各指導者をもっとも特徴付ける単語を調べる # 全指導者の文書-単語行列を低ランク行列で再現 docterm.app <- svd.docterm.low$u %*% diag(svd.docterm.low$d) %*% t(svd.docterm.low$v) # トランプ大統領をもっとも特徴付ける単語を取得 term.trump <- docterm.app[,index.trump] # トランプ偏差値トップの人をもっとも特徴付ける単語を取得 index.toptrumper <- which(rownames(svd.docterm.low$v) == names(trump.order)[1]) term.toptrumper <- docterm.app[,index.toptrumper] # それぞれの特徴語の表示 print(term.trump[order(-term.trump)][1:10]) print(term.toptrumper[order(-term.toptrumper)][1:10])
> print(term.trump[order(-term.trump)][1:10])
トランプ 中国 北朝鮮 こと 発言 フィリピン 者 米国 大統領 人
0.34969567 0.20357833 0.17085699 0.13165502 0.12459490 0.10411936 0.10155474 0.09888835 0.09590375 0.09159767
> print(term.toptrumper[order(-term.toptrumper)][1:10])
中国 トランプ 大統領 北朝鮮 年 フィリピン 依存 発言 こと 政策
0.18541337 0.15940956 0.11098858 0.08911449 0.07826024 0.07240096 0.06509865 0.06227812 0.06085533 0.05706989
やはり、トランプ、大統領、といった単語が含まれていますね。
他には、中国、北朝鮮、といった単語が共通して出ており、体外的な交渉相手などが似ているということでしょうか。
まぁここに関しては、日本のwikipediaを解析しているため、日本から見た動きが記載されやすい、というバイアスは大きく受けている気はします。
実際に似ているかはともかく、日本から見た影響力の大きさ、という点では似ているのかもしれませんね。
おまけ：理想の指導者を探してみる
潜在的意味解析の面白いところは、文書の検索もできるところです。
任意の文書をクエリとして与え、そこに含まれる単語を潜在意味空間に射影することで、文書との距離を計算できるようになります。
では実際に、理想の指導者に最も類似する指導者を探してみましょう。
まずは、クエリを与えると、それに最も近い5つの文書を返す関数を定義しましょう。
## 理想の指導者を探してみる
# 理想の指導者検索関数の設定
searchLeader <- function(query, docterm){
# 長さ1の文字列のみ受付
if(mode(query) != "character") return(NULL)
if(length(query) > 1) return(NULL)
# 形態素解析
query.term <- RMeCabC(query) %>% unlist()
# 動詞，形容詞だけ取り出す
query.term <- query.term[names(query.term) %in% c("名詞", "形容詞")]
# 文書-単語行列に含まれるもののみを取り出し，ベクトルを生成
term.list <- matrix(0, nrow=nrow(docterm$u))
rownames(term.list) <- rownames(docterm$u)
term.list[rownames(term.list) %in% query.term] <- 1
# 使用される単語を確認
cat("Using terms:\n")
print(term.list[which(term.list[,1] == 1), ])
# 文書-単語行列に全く一致する単語がない場合はNULLを返す
if(sum(term.list) == 0) return(NULL)
# 潜在意味空間中での質問文ベクトルを計算
query.vec <- t(term.list) %*% docterm$u %*% solve(diag(docterm$d))
query.vec <- as.vector(query.vec)
# 潜在意味空間中でのcosine類似度を計算
mat.v <- t(docterm$v)
query.cos <- apply(mat.v, 2, function(x){
crossprod(x, query.vec) / (sqrt(crossprod(x) * crossprod(query.vec)))
})
rank.leader <- round(sort(query.cos,de=T),3)
return(rank.leader[1:5])
}
では、この関数を使用して、理想の指導者を探してみましょう。
以下のようなクエリを与えてみます。
# 指導者検索してみる query <- "効果的な政策を実現することができ，経済の発展に貢献し，人々から賞賛され，尊敬を集める"
これが理想的な指導者かどうかは微妙ですが、すばらしい人物には違いないですね！
では検索してみましょう！
res <- searchLeader(query, svd.docterm.low) print(res)
> res <- searchLeader(query, svd.docterm.low)
Using terms:
こと 的 経済 効果 貢献 実現 人々 政策 尊敬 発展
1 1 1 1 1 1 1 1 1 1
> print(res)
スリランカ 大統領 マイトリーパーラ・シリセーナ.txt ジョージア 首相 ギオルギ・クヴィリカシヴィリ.txt
0.477 0.427
ジョージア 大統領 ギオルギ・マルグヴェラシヴィリ.txt インドネシア 大統領 ジョコ・ウィドド.txt
0.377 0.372
コスタリカ 大統領 ルイス・ギジェルモ・ソリス.txt
0.328
スリランカの大統領が一番該当すると出てきました。
ちょっとどんな人物か良くわからないので、wikipediaページを見てみましょう。
んー、特別クエリに該当しているようには思えないんですが……
取り合えず文章が短めなので、出現する単語の種類が少なくなり、「政策」とか単語の重みが強くなったんでしょうか。
試しにほかのクエリでもやって見ます。
query <- "親日で日本が大好きで友好的" res <- searchLeader(query, svd.docterm.low) print(res)
> res <- searchLeader(query, svd.docterm.low)
Using terms:
的 日本 友好
1 1 1
> print(res)
シンガポール 首相 リー・シェンロン.txt パラオ 大統領 トミー・レメンゲサウ.txt
0.914 0.475
モルディブ 大統領 アブドゥラ・ヤミーン.txt 日本 内閣総理大臣 安倍晋三.txt
0.457 0.320
ツバル 総督 イアコバ・イタレリ.txt
0.190
リーシェンロン首相はこんな人です。
うーん、また文章が短く、日本に関する記述が目立ちますね。
どうも、検索のような短いクエリと距離を計算すると、文書が短く、たまたまクエリに近い単語を含んでいる文書が上位に上がってきてしまうようです。
今回のような各文書に含まれる単語数が大きく違う場合は、一工夫必要そうです。
まとめ
今回は潜在的意味解析を用いて、トランプ大統領と金正日氏の類似度を判定してみました。
その結果、実はトランプ大統領が似ているのは金正日氏ではなく、ダントツでフィリピンのドゥテルテ大統領であることがわかりました（飽くまで今回の解析の結果です）。
今回は日本のwikipediaの文書を解析したため、日本の視点から見た行動、というバイアスのかかった結果になってしまいましたが、例えばTwitter上での指導者に対する意見を分析するなどすれば、世間からどう思われているかという点での類似度が計算できるかもしれません。
ちなみに潜在的意味解析の改良法で確率的潜在意味解析（PLSA）という手法もあるので、時間があれば勉強してみたいですね。
