トランプ大統領と金正恩氏の類似度を潜在的意味解析で判定する その１
こんにちは、雑魚エンジニアのtoshiです。
最近、トランプ大統領と金正恩氏が似ていると、ネット上で言われるようになってきました。 その証拠に、Google検索で「トランプ 金正日」と入力すると、サジェストに「似てる」という単語が上位に出てきます。
お互い過激な発言が目立ちますから、仕方ないかなぁ、といったところですね。
さて、今回はそんな二人が本当に似ているのかどうか、潜在的意味解析という技術を使って解析してみたいと思います。
潜在的意味解析とは
潜在的意味解析（LSA）とは、文書に存在する単語を用いて、潜在的なトピックを抽出する技法です。
具体的に言うと、文書に存在する単語を出現回数を数え上げたベクトルに変換（Bag of Words）し、SVDによる低ランク近似を行います。
そうすることで、類義語のような、同じような使われ方をする単語が潜在的なトピックとして畳み込まれます。
そのため、単純に文書-単語行列によって類似度を判定するのと比べ、より柔軟に類似度判定を行うことができます。
潜在的意味解析の詳細な説明は省きますが、もう少しわかりやすく知りたければ、以下のあらびきさんのエントリが分かりやすいです（潜在的意味インデキシング（LSI）と書かれていますが、潜在的意味解析と同じです）。
作業環境と手順
以下の環境で作業を行います。
以下のような手順で解析を行っていきます
では、早速やっていきましょう！
１．wikipediaから各国の指導者一覧を取得
Webスクレイピングを行うには、rvestというパッケージが利用できます。 CRANからインストールできますので、しておきましょう。
install.package("rvest")
ちなみにDBpediaからSPARQLでデータ引っ張ってくることも考えたのですが、DBpedia上の各国の指導者一覧ページが最新でなかったため、wikipediaからスクレイピングすることにしました。
さて、各国の指導者一覧のHTMLを読み込むコードを以下に示します。
### 0. 準備
# カレントディレクトリの設定
setwd("~/R_workspace/LSA")
# パッケージの読み込み
library("rvest")
### 1. wikipediaから各国の指導者一覧を取得
# 各国の指導者一覧HTMLの取得
url <- "https://ja.wikipedia.org/wiki/%E4%B8%96%E7%95%8C%E5%90%84%E5%9B%BD%E3%81%AE%E6%8C%87%E5%B0%8E%E8%80%85%E4%B8%80%E8%A6%A7"
data.html <- read_html(url)
# 指導者テーブルの取得
html.table <- data.html %>% html_nodes(xpath="//table") %>% .[1] %>%
iconv(from = "UTF-8", to="UTF-8")
read_html関数でHTMLを読み込んだ後、html_nodes関数でタグを指定してやることで、そのタグを持つHTMLコードだけを取得できます。 今回はtableタグを指定しているので、テーブルだけが取得できています。
目的のテーブルは1番目のテーブルなので、1番目の要素を取り出し、iconv関数で文字化けを解消しておきます。 iconv関数は文字コードを変換するためのものですが、これをしておかないととんでもなく文字化けするので、重要です。
さて、本来であればここからhtml_tableという関数を用いることでテーブルの各セルの要素を取り出すことができるのですが、
- html_table関数では結合セルをうまく扱えない
- html_table関数では要素だけをdata.frameに変換するためハイパーリンクが取り出せない
ことから、自力でHTMLコードを解析していきたいと思います。
少し煩雑になりますが、以下がテーブルのHTMLから各要素を取り出すコードです。
# trタグで分割して、各行のデータを取り出す
html.leaders <- html.table %>% strsplit("<tr>") %>% .[[1]]
# 各指導者ごとにデータを作成
len <- length(html.leaders)
table.leader <- data.frame("国名"=rep(NA, len - 2),
"役職"=rep(NA, len - 2),
"名前"=rep(NA, len - 2),
"URL"=rep(NA, len - 2))
# HTMLを自力で分解する
# 1,2行目はヘッダなのでスルー
for(index.loop in 3:len){
# tdタグで分割
td.vec <- html.leaders[index.loop] %>% strsplit("<td") %>% .[[1]]
# td.vec[1]から国名を取得
# 結合セルの関係で既に埋められている場合スルー
if(is.na(table.leader[index.loop - 2, "国名"])){
# 結合セルだった場合，先のデータも埋めるため変数にrowspanを代入
if(length(grep("rowspan", td.vec[1])) > 0){
rowspan <- td.vec[1] %>% strsplit("rowspan=\"") %>% .[[1]] %>%
.[2] %>% strsplit("\"") %>% .[[1]] %>% .[1] %>% as.numeric()
} else {
rowspan <- 1
}
# タグの後ろにある要素を取り出す
td.split <- td.vec[1] %>% strsplit(">") %>% .[[1]]
for(sub.loop in 1:length(td.split)){
# 国名はaタグの終わり前にあるため,</で分割できた0文字以上の要素を取出
temp.data <- td.split[sub.loop] %>% strsplit("</") %>% .[[1]]
if(length(temp.data) > 1 & nchar(temp.data[1]) > 1){
# 結合セルの場合、複数セル分の国名を代入する
start <- index.loop - 2
end <- start + rowspan - 1
table.leader[start:end , "国名"] <- temp.data[1]
break
}
}
}
# td.vec[2]から役職を取得
# 結合セルの関係で既に埋められている場合スルー
if(is.na(table.leader[index.loop - 2, "役職"])){
# 結合セルだった場合，先のデータも埋めるため変数にrowspanを代入
if(length(grep("rowspan", td.vec[2])) > 0){
rowspan <- td.vec[2] %>% strsplit("rowspan=\"") %>% .[[1]] %>%
.[2] %>% strsplit("\"") %>% .[[1]] %>% .[1] %>% as.numeric()
} else {
rowspan <- 1
}
# タグの後ろにある要素を取り出す
td.split <- td.vec[2] %>% strsplit(">") %>% .[[1]]
for(sub.loop in 1:length(td.split)){
# 役職名もaタグの終わり前にあるため,</で分割できた0文字以上の要素を取出
temp.data <- td.split[sub.loop] %>% strsplit("</") %>% .[[1]]
if(length(temp.data) > 1 & nchar(temp.data[1]) > 0){
# 結合セルの場合、複数セル分の役職名を代入する
start <- index.loop - 2
end <- start + rowspan - 1
table.leader[start:end, "役職"] <- temp.data[1]
break
}
}
# 名前が入っているデータのインデックスを設定
name.index <- 3
} else {
# 役職が結合セルの場合，名前が入っているインデックスがずれるので補正
name.index <- 2
}
# 名前とURLを取得
# タグの後ろにある要素を取り出す
td.split <- td.vec[name.index] %>% strsplit(">") %>% .[[1]]
for(sub.loop in 1:length(td.split)){
# リンクが存在する要素にリンクと名前が入っているため、href="で分割
temp.data <- td.split[sub.loop] %>% strsplit("href=\"") %>% .[[1]]
if(length(temp.data) > 1){
# URLと名前をそれぞれ取り出して記録
temp.data <- temp.data[2] %>% strsplit("\"") %>% .[[1]]
table.leader[index.loop - 2, "URL"] <-
paste0("https://ja.wikipedia.org", temp.data[1])
table.leader[index.loop - 2, "名前"] <-
td.split[sub.loop + 1] %>% strsplit("</") %>% .[[1]] %>% .[1]
break
}
}
}
# 一人の人物が複数の役職を兼任している場合，2つ目の役職の名前とURLにNAが入っているので削除
table.leader <- na.omit(table.leader)
だいぶ愚直に書きましたが、いちおうこれでテーブルのHTMLから各国の指導者情報を取り出すことができます。 HTMLの構造が変わると対応できない等、結構クソコードな気はしますが……
まぁ、スクレイピング部分は今回のお題の本質的な部分ではないので良しとしましょう（^_^;）
さて、中身を確認してみましょう。
# ちゃんと取れているか確認 View(table.leader)
どうやらちゃんと取れてそうですね。
では、このデータを保存して、余分な変数を削除しておきましょう。
# table.leaderの保存 save(table.leader, file="./table_leader.Rdata") # 要らない変数を削除 rm(list=ls()) gc(); gc();
２．各国の指導者の各ページから説明文を抽出
各国の指導者の説明文も、rvestパッケージで取得することができます。
前回はテーブルの読み込みだったため html_nodes関数においてtableタグを指定しましたが、今回はpタグを指定して読み込みましょう。
以下に、それぞれの説明文を取得するコードを示します。
### 2. 各指導者のWikipediaページから説明文を取得し保存する
# table.leaderの読み込み
load("./table_leader.Rdata")
# 説明文の保存先作成
path.dir <- "./desc"
if(!file.exists(path.dir)) dir.create(path.dir)
# 全指導者の説明文を取得し保存
for(index.loop in 1:nrow(table.leader)){
# URL設定
url <- table.leader[index.loop,4]
# タイムアウトの回数を記録する変数の作成
timeout.count <- 0
# データの取得
while(TRUE){
data.html <- try(read_html(url), silent = FALSE)
# データが取得できた場合と，404エラーの場合は次の処理へ
if(class(data.html)[1] != "try-error"){
break
} else if(length(grep("error 404", data.html[1])) > 0){
break
}
# タイムアウト等のエラーの場合は5秒まってリトライ
Sys.sleep(5)
# タイムアウトの回数を記録し、10回連続失敗したら諦める
timeout.count <- timeout.count + 1
if(timeout.count >= 10) break
}
# 記事が存在しない場合はスルー
if (class(data.html)[1] != "try-error" & timeout.count < 10) {
# 本文の取得
sentence.main <- data.html %>% html_nodes(xpath="//p") %>%
iconv(from = "UTF-8", to="UTF-8")
# 全文の結合
sentence.main.all <- paste(sentence.main, collapse = "")
# タグと参考文献の削除
sentence.main.notag <- gsub("\\[.*?]", "",
gsub("<.*?>", "", sentence.main.all))
# 括弧書きの削除
sentence.main.notag <- gsub("（.*?）", "",
gsub("\\(.*?)", "", sentence.main.notag))
# 説明文を保存
filename <- paste0(path.dir, "/",
paste(table.leader[index.loop,1:3], collapse=" "), ".txt")
write(sentence.main.notag, filename)
}
cat("finish : ", index.loop, "/", nrow(table.leader), "\n")
}
# 要らない変数を削除
rm(list=ls())
gc(); gc();
後にRMeCabを用いて文書-単語行列に変換するために、それぞれの説明文を「国名 役職名 人名」のファイル名で保存しています。
さて、ちゃんと取れているか、保存したテキストファイルを確認してみましょう。
長いですが、取れてそうですね。
続きは次回の記事で
まだ下準備しかできていませんが、だいぶ長くなってしまったので、続きは次回記事で紹介したいと思います。
果たしてトランプ大統領と金正恩氏は似ているのか！？
乞うご期待です！
次回記事はこちら
