LDA: Topic Analysis of a Secret Society
最近 トピックモデルのいい本が出たようで、自分はまだ買ってないんだがちょっとやってみたい。
なんかいい対象ないかな？とネットを探していたら、こんなあやしげな集団をみつけた。この人たちがどういうトピックについて会話しているのか確認したい。
理論よくわかってないので、知的集団の言語処理勢の方の解説に期待。
twitter からのデータ取得
まずは上のリストに含まれる方のタイムラインを取得したい。R には {twitteR} というパッケージがあるが、リストからのタイムライン取得には対応していないようだ。ふつうに Twitter API から取得してパースする。
require(httr)
require(jsonlite)
app_name <- 'App Name'
key <- 'API Key'
secret <- 'API Secret'
token <- 'Access Token'
token_secret <- 'Access Token Secret'tw <- httr::oauth_app(app_name, key = key, secret = secret)
# to skip dialogue
options(httr_oauth_cache = TRUE)
sig <- httr::sign_oauth1.0(tw, token = token, token_secret = token_secret)
# 1回で取得できるのが 200 件のようなので とりあえずそれだけ
list_name <- 'list'
list_owner <- 'teramonagi'
list_count <- 200
url <- paste0('https://api.twitter.com/1.1/lists/statuses.json?slug=',
list_name, '&owner_screen_name=', list_owner,
'&count=', list_count)
cont <- httr::content(httr::GET(url, sig))
jsonized = jsonlite::fromJSON(toJSON(cont))
# 取得時刻
Sys.time()## [1] "2015-03-27 01:19:54 JST"前処理
twitter のタイムラインからわかる情報には 当人の発言だけでなく Fav や Retweet など 様々なものがあるが、今回は話題を見たいだけなので本人の発言のテキスト部分だけを抽出して使う。
df <- jsonized
colnames(df)## [1] "created_at" "id"
## [3] "id_str" "text"
## [5] "source" "truncated"
## [7] "in_reply_to_status_id" "in_reply_to_status_id_str"
## [9] "in_reply_to_user_id" "in_reply_to_user_id_str"
## [11] "in_reply_to_screen_name" "user"
## [13] "geo" "coordinates"
## [15] "place" "contributors"
## [17] "retweeted_status" "retweet_count"
## [19] "favorite_count" "entities"
## [21] "favorited" "retweeted"
## [23] "possibly_sensitive" "lang"
## [25] "extended_entities"# 一部のカラムは入れ子になっている
head(df[['user']][1:5])## id id_str name screen_name location
## 1 555168944 555168944 ホクソウヌス Prunus1350
## 2 266022457 266022457 ホクソッチ sanoche16 六本木
## 3 266022457 266022457 ホクソッチ sanoche16 六本木
## 4 555168944 555168944 ホクソウヌス Prunus1350
## 5 555168944 555168944 ホクソウヌス Prunus1350
## 6 555168944 555168944 ホクソウヌス Prunus1350# 適当な列のみ抽出
df <- data.frame(created = df['created_at'],
username = df[['user']]['name'],
screenname = df[['user']]['screen_name'],
text = df['text'],
retweet = df[['retweeted_status']]['id'])
# 列名がうまく設定されないので上書き
colnames(df) <- c('created', 'username', 'screenname', 'text', 'retweet')
# retweet を除外
df <- df[unlist(lapply(df[, 'retweet'], is.null)), ]
head(df)## created username screenname
## 2 Thu Mar 26 15:58:57 +0000 2015 ホクソッチ sanoche16
## 4 Thu Mar 26 15:29:45 +0000 2015 ホクソウヌス Prunus1350
## 5 Thu Mar 26 15:29:20 +0000 2015 ホクソウヌス Prunus1350
## 6 Thu Mar 26 15:28:40 +0000 2015 ホクソウヌス Prunus1350
## 7 Thu Mar 26 15:28:01 +0000 2015 ホクソウヌス Prunus1350
## 9 Thu Mar 26 15:24:52 +0000 2015 ホクソヤン piroyoung
## text retweet
## 2 @berobero11 この質問すごい笑 NULL
## 4 さすがにこれはダメか。 NULL
## 5 引用ツイートの表示が変わったみたい。\n https://t.co/qpP0etzvS7 NULL
## 6 引用ツイートの表示が変わったみたい。 https://t.co/04QULbrkvE NULL
## 7 引用ツイートの表示が変わったみたい。 NULL
## 9 @hoxo_m 金曜になったみたいですが誰も驚いていないというね笑 NULL次に、{RMeCab} で形態素解析して Document-Term Matrix を作る。data.frame から Document-Term Matrix を作るには RMeCab::docMatrixDF。{RMeCab}での Document-Term Matrix の作り方はこちらが詳しい。
http://rmecab.jp/wiki/index.php?plugin=attach&refer=SoftArchive&openfile=manual100831.pdf
補足 MeCab の辞書には neologd を使っている。R での設定は、
http://d.hatena.ne.jp/dichika/20150326
library(tm)
library(RMeCab)
parsed <- RMeCab::docMatrixDF(df[, 'text'], pos = c("名詞", "形容詞", "動詞"))## to make data framecolnames(parsed) <- unlist(df[, 'username'])また、不要と考えられる stop words は 目視で 除外する、、。対象の集団的に C, R, S あたりは意味を持っている可能性があるので残す。
stopwords <- c("!", "!!", "!!!", "!!!!????", "\")", "(\"", "(´･_･`)", "(•", ")(", ")。", "+", "...※", ".@",
"\"", "#", "&", "'", "(", ")", ",", "-", ".", "...", "/", "0", "1", "10", "1000", "14", "2",
"2Z", "3", "30", "3M", "3R", "4", "4P", "5", "6", "7", "8", "80", "9", "00", "04", "085",
"100", "1019", "1031", "109", "11", "12", "1350", "18", "19", "20", "22", "23", "27", "28日",
"2G", "2X", "2号", "344", "357", "3D", "44", "45", "500", "542", "5月23日", "630", "6376",
"9S", ";&", ";;", "@IT", "@_", ":", "://", ";", "?", "@", "A", "RT", "http://", "co", "_", "ー",
"ん", "t", "in", "N", "Q", "ﾟ", "JP", "\\", "]", "a", "I", "一", "P", "V", "vvvv", "m", "w",
"the", "z", "w/", "|", "д", "⇒", "♪", "あれ", "の", "さん", "的", "む", "あと", "いい", "いま",
"こと", "こないだ", "これ", "さ", "さん", "せい", "そう", "それ", "気", "系", "よう", "方",
"ある", "する", "いる", "やる", "れる", "できる", "られる", "てる", "化", "もの", "なる")
parsed <- parsed[setdiff(rownames(parsed), stopwords), ]
# 1回しか出現しない Termを除外
parsed <- parsed[!(rowSums(parsed) <= 1), ]
# Term を含まない Document は削除
parsed <- parsed[, !(colSums(parsed) == 0)]
head(parsed[, 1:4])## ホクソッチ ホクソウヌス ホクソウヌス ホクソウヌス
## AT 0 0 0 0
## Amazon 0 0 0 0
## BDA 0 0 0 0
## DiagrammeR 0 0 0 0
## GT 0 0 0 0
## HAD 0 0 0 0LDA の実行
LDA は {topicmodels} パッケージの LDA 関数を利用する。そのためには、データを slam::simple_triplet_matrix に変換 -> その後 tm::DocumentTermMatrix に変換する必要がある。
library(slam)
stm <- slam::as.simple_triplet_matrix(t(parsed))
library(tm)
dtm <- tm::as.DocumentTermMatrix(stm, weighting = tm::weightTf)ここまでできれば、あとは LDA に渡すだけ。特に根拠はないが、トピック数は 10 にした。意味がとれそうなものもあるし、複数トピックが混ざっていそうなものもある。
library(topicmodels)
lda <- topicmodels::LDA(dtm, 10)
# 各トピックの頻出単語
terms(lda, 10)## Topic 1 Topic 2 Topic 3 Topic 4 Topic 5
## [1,] "R" "わけ" "章" "人" "言う"
## [2,] "Linux" "HTTPS" "みんな" "時間" "使う"
## [3,] "辞書" "AT" "ベイズ" "blog" "twitteR"
## [4,] "指定" "motivic" "統計" "なに" "ない"
## [5,] "mecabrc" "おる" "締切" "ガウス" "聞く"
## [6,] "残念" "みる" "GT" "ガンマ分布" "知る"
## [7,] "Tokyo" "やる気" "データ" "チェック" "R"
## [8,] "dichika" "ビール" "サイエンティスト" "ハンズオン" "HAD"
## [9,] "kazutan" "広島市" "延ばす" "中身" "credentials"
## [10,] "引数" "広島県" "進捗" "今日" "to"
## Topic 6 Topic 7 Topic 8 Topic 9
## [1,] "ソン" "話" "くる" "tweet"
## [2,] "参加" "良い" "いう" "みたい"
## [3,] "肉" "考える" "Amazon" "RMeCab"
## [4,] "DiagrammeR" "読む" "evince" "neologd"
## [5,] "うむ" "TL" "thumbnailer" "変わる"
## [6,] "して" "divergence" "しまう" "引用"
## [7,] "ソフト" "本" "ラーメン" "表示"
## [8,] "同期" "BDA" "リソース" "例"
## [9,] "聴衆" "KL" "作者" "HTTPS"
## [10,] "自分" "対称" "商品" "笑"
## Topic 10
## [1,] "始める"
## [2,] "ラテアートアイコン"
## [3,] "Model"
## [4,] "iQON"
## [5,] "イラスト"
## [6,] "パッケージ"
## [7,] "一人"
## [8,] "人工知能"
## [9,] "公開"
## [10,] "帰る"tops <- topics(lda)
tb <- table(names(tops), unlist(tops))
tb <- as.data.frame.matrix(tb)どういったトピックについてよく話しているかでクラスタリングする。正規化していないので発言数でクラスタになってしまっているような気もする。
cls <- hclust(dist(tb), method = 'ward.D2')
par(family = "HiraKakuProN-W3")
plot(cls)