からっぽのしょこ

読んだら書く!書いたら読む!読書読読書読書♪同じ事は二度調べ(たく)ない

R言語でトピックモデルとクラスタリング

はじめに

 複数のテキストを対象に、トピックモデル(LDA:Latent Dirichlet Allocation)によるテキスト分析を行います。その分析結果を基にクラスタリングを行い、デンドログラム(樹形図)による可視化を行います。
 この記事の内容は『テキストアナリティクス』著:金明哲を参考にしています。参考書の通りだと可視化の段階でトピックとタームにズレが生じるため、目・手作業での修正が必要でした。そこで、LDA()によるトピックのナンバリングとhclust(dist())によるナンバリングが自動で調整されるようにしました。なお、理論面の解説はありません(勉強中)。

www.anarchive-beta.com

www.anarchive-beta.com

 理論面の記事も書きました。(追記)

f:id:anemptyarchive:20190328103841p:plain
図1:調整前

 図1は手作業での修正を行わなかった場合の出力結果です。

 図1上部の樹形図の各テキストの配置は、hclust(dist())によって機械的に決まります。その配置の左からトピック1・2・3とします。この例では「ひらパー(ひらかたパーク)」や「鴨川シーワールド」は樹形図の左側に配置されているので、トピック1のグループとしたいです。しかしその順序は、LDA()によって割り振られるナンバリングと異なります。

f:id:anemptyarchive:20190328170615p:plain
LDA()によるトピックのナンバリング
 「鴨川シーワールド」「ひらパー」はトピック3となっています。

 図1下部の棒グラフ(トピック推定のための影響度のようなもの)の配置には、LDA()によるナンバリングされた値を用います。その為、「(鴨川)シーワールド」や「(ひら)パー」を含む単語群がトピック3として右端に配置されています。
 これを修正するには、都度目で確認して手作業で単語群の配置(matrixから対応する列を指定する)を調整する必要があります(割と面倒)。

 このズレの修正を自動で行うようにするのがこの記事の最大の目的です。

目次



トピックモデルによる分析と可視化

 使用するテキストは、各テーマパークの公式Twitterアカウントのツイートテキストを2019/03/14に500件収集したもの。

前処理

・利用パッケージ

# 利用するパッケージの読み込み
library(RMeCab) # docDF()
library(dplyr) # filter(),grepl(),select(),%>%
library(stringr) # str_remove_all()


・形態素解析

# テキストファイルのあるディレクトリを指定
file_path <- "ディレクトリ名"

#形態素解析を行う
mecab_df1 <- docDF(file_path, type = 1)

 docDF()にファイルの位置を指定して、MeCabによって形態素解析を行う。type=1を指定することで文章を単語(形態素)に分割する。

・品詞による単語の選択

# 必要な単語のみを抽出する
mecab_df2 <- mecab_df1 %>% 
             filter(POS1 == "名詞" & POS2 == "一般") %>% 
             filter(!grepl("[0-9a-zA-Z]", TERM))

# 列名を書き換える
colnames(mecab_df2) <- colnames(mecab_df2) %>% 
                       str_remove_all(".txt")

 品詞を指定して単語を絞り込む。加えて、MeCabで解析できない英単語類を取り除く。また、docDF()の結果は列名が各テキストファイル名となるので、不要な拡張子の部分も消しておく。

品詞を複数指定する場合(クリックで展開)

 複数の品詞を指定して単語を抽出する場合は次のようにする。

mecab_df2 <- mecab_df1 %>% 
             filter(POS1 == "名詞" | POS1 == "動詞") %>% 
             filter(POS2 == "一般" | POS2 == "自立")

あるいはgrepl()を利用して

mecab_df2 <- mecab_df1  %>% 
             filter(grepl("名詞|動詞", POS1)) %>% 
             filter(grepl("^一般$|^自立$", POS2))

とする。ただしgrepl()は部分一致で検索するので、正規表現の^(行頭の指定)と$(行末の指定)を利用する。


・頻度による単語の選択

# 頻度の合計値の列を付け加える
mecab_df2$total <- mecab_df2 %>%  
                   select(-c(TERM, POS1, POS2)) %>% 
                   apply(1, sum)  

# 頻度を指定して単語を抽出する
mecab_df3 <- mecab_df2 %>% 
             filter(total >= 40)

# 語数の確認
nrow(mecab_df3)

 apply()を使って、全テキストでの出現頻度を求めて、total列を加える。その合計頻度を使って単語を抽出する。

LDA()に渡すための整形

# データフレームを整形
mecab_df4 <- mecab_df3 %>% 
             select(-c(TERM, POS1, POS2, total)) %>%
             t() %>% 
             as.data.frame()

# 列名を書き換える
colnames(mecab_df4) <- mecab_df3$TERM

 LDA()に対応するために、行に文書情報、列に単語情報のデータフレームに整形する。
 不要になった列は選択せず、t()で転置する。t()を使うとmatrixになるためas.data.frame()でdata.frameに戻す。また、列名(単語情報)が抜けてしまうので、colnames()を使って名付け直す。

 前処理は以上。続いてトピックモデルによる分析を行う。

分析

・利用パッケージ

# 利用するパッケージの読み込み
library(topicmodels) # LDA(), terms(), terms(), topics()

(slamパッケージtmパッケージも使ってたはずなのだが読み込まなくても再現できた…??)

## 分析
res_lda <- LDA(mecab_df4, method = "Gibbs", k = 3)

 LDA()を使ってテキスト分析を行う。分析にはランダムな要素が含まれるため都度結果が変化する。k = nで推定するトピック数を指定できる。

・トピックと単語の確認

# 各テキストのトピックを確認
topic_num <- topics(res_lda)
topic_num
##   AdventureWorld     AsahiyamaZoo          Hirapar     Huistenbosch 
##                2                3                3                1 
## KamogawaSeaworld     TobaAquarium          UenoZoo 
##                3                3                1

# 各トピックの単語を確認
terms(res_lda, 10)
##       Topic 1              Topic 2                  Topic 3       
##  [1,] "月"                 "パンダ"                 "動物"        
##  [2,] "ジャイアントパンダ" "アドベンチャーワールド" "月"          
##  [3,] "時刻"               "月"                     "シーワールド"
##  [4,] "待ち時間"           "赤ちゃん"               "情報"        
##  [5,] "花火"               "体重"                   "パー"        
##  [6,] "最終"               "浜"                     "シェア"      
##  [7,] "状況"               "齢"                     "タイム"      
##  [8,] "閉園"               "お母さん"               "セイウチ"    
##  [9,] "パンダ"             "名前"                   "スケジュール"
## [10,] "動物"               "メス"                   "ショー"

# 単語とトピックを抜き出す
term <- t(posterior(res_lda)$term)
topic <- posterior(res_lda)$topic

 分析結果から単語とトピックに関する情報を取り出す。(この単語群をそのままプロットできないのが問題)

・クラスタリング

# クラスタリング
hc <- hclust(dist(topic), "ward.D2")

 非類似度を距離として、距離の近いテキストをクラスタリング(グループ化)していく。
 結果(hc)はlistで返ってくる。

・トピックのナンバリングの調整

# ズレ調整用の処理
t1 <- topic_num[hc$order[1]]
t3 <- topic_num[hc$order[length(hc$order)]]
t2 <- 6 - t1 - t3

 hc$orderは、樹形図の左からそれぞれがどのテキストなのかを示している。hc$labelsには、テキスト名の情報が格納されている。hc$orderの1つ目の要素は樹形図上のトピック1のテキスト、最後の要素は樹形図上のトピック3のテキストである(トピック数を3と指定した場合)。
 これを利用して、プロット時に各トピックのに対応する単語を配置するための準備をしておく。

・詳しい処理の説明(その前に一度可視化の所まで読んだ方が理解が早いかもしれません)

f:id:anemptyarchive:20190328134025p:plain
クラスタリング・樹形図上のナンバリング:hc$orderの内容
f:id:anemptyarchive:20190328170615p:plain
LDA()によるナンバリング:topic_numの内容

 hc$orderの1つ目の要素は、樹形図に配置されている左端のテキストがhc$labelsのどの要素であるか(つまりどのテキストであるか)を示している。hc$labelsの順番はtopic_num(更にいうとmecab_df4の行番号も)と同じである。
 なので、hc$order[1]が3(テキストを示す値)であることから、topic_numの3つ目の要素(LDA()によって決められたトピックの値:3,要素名:Hirapar)であることが分かる。
 これらを添え字として利用する(t1 <- topic_num[3])ことで、topic_numの3つ目のテキスト(Hirapar)を指定して、そのテキストがLDA()による振り分けでは(トピック)3であるという情報を得ることができる。

 t3は、樹形図の右端つまりhc$orderの最後の要素をlength(hc$order)で指定して、同様の処理を行っている。

 t2は、(トピックの値)1,2,3の合計値6からt1,t3を引くことで求めている。今回の例では、「6-(Hiraparのトピックの値)1-(TobaAquariumのトピックの値)3=(残りのトピックの値)2」と分かる。

トピック数が4以上の場合(クリックで展開)

# k = 4と指定した場合
t1 <- topic_num[hc$order[1]]
t4 <- topic_num[hc$order[length(hc$order)]]
t23 <- hc$order[(length(topic_num[topic_num == t1]) + 1):(length(topic_num) - length(topic_num[topic_num == t4]))]
t2 <- topic_num[t23[1]]
t3 <- topic_num[t23[length(t23)]]

 t1,t4は同様の処理を行っている。
 t23は、hc$orderの要素を、前からトピック1のテキスト数分(length(topic_num[topic_num == t1]))を除き、更に後ろからもトピック4のテキスト数分(length(topic_num[topic_num == t4]))を除いて取り出したものである。全テキスト数をN、トピック1のテキスト数をA、トピック4のテキスト数をBとするとt23 <- hc$order[(A + 1):(N - B)]となっている。つまり、トピック2・3のテキスト分だけを取り出せた。
 t2,t3は、t23t1,t4と同様の処理を行っている。

・その他の解決策(手作業)

# トピック1
term1 <- as.matrix(term[, topic_num["Hirapar"]])

 各トピックの単語群をプロット時にt1~t3を使わずに、樹形図を確認して各トピックに含まれるテキストを直接topic_num["テキスト名"]と指定することで入れ替わらずに配置できる。
 topic_numベクトルの各要素の名前を添え字として使って、LDA()によって付けられたトピックの値を取り出して利用している。


可視化

・デンドログラムの作図

# 樹形図
split.screen(figs = c(2, 1))
screen(1)
par(mar = c(1, 4, 2, 2))
plot(hc, hang = -1, xlab = "", sub = "")
rect.hclust(hc, k = 3, border = 2:4)

 split.screen()screen()で描画画面の分割と位置の指定を行う。par(mar = c(1, 1, 1, 1))は周りの余白の指定。
 クラスタリングの結果を基に樹形図をplot()で作図する。rect.hclust()を使ってグループの枠を記す。

# トピック1
split.screen(figs = c(1, 3), screen = 2)
par(mar = c(4, 4, 1, 1))
screen(3)
term1 <- as.matrix(term[, t1])
term11 <- sort(term1[, 1], decreasing = FALSE)
barplot(tail(term11, 10), las = 2, horiz = TRUE, col = 2, main = "Topic1")

# トピック2
screen(4)
par(mar = c(4, 4, 1, 1))
term2 <- as.matrix(term[, t2])
term21 <- sort(term2[, 1], decreasing = FALSE)
barplot(tail(term21, 10), las = 2, horiz = TRUE, col = 3, main = "Topic2")

# トピック3
screen(5)
par(mar = c(4, 4, 1, 1))
term3 <- as.matrix(term[, t3])
term31 <- sort(term3[, 1], decreasing = FALSE)
barplot(tail(term31, 10), las = 2, horiz = TRUE, col = 4, main = "Topic3")

 各トピックの単語群をtermから取り出して、sort(, decreasing = FALSE)で降順に並び替えて、barplot()で棒グラフにする。
 termは3列(k=nで指定した列数)のmatrixで、各トピックに対応する列を指定して取り出さなければならない。
 この時、樹形図に配置されているテキストグループに合わせて単語群を配置したい。しかしその順番は、LDA()によって決まるtermの列順とは異なる。その為、ズレたトピックと各単語群とを対応させるのにひと工夫が必要となる(詳しくは「トピックのナンバリングの調整」の節を参照ください)。
 それをt1,t2,t3を使って列を指定することで対応する。

f:id:anemptyarchive:20190328103927p:plain
調整後

以上です!

主な参考文献

  • 金明哲(2018)『テキストアナリティクス』(統計学One Point10)共立出版


おわりに

 訳あって『テキストアナリティクス』に手を出してみました。この本を理解するのが目標なのですが難しいです。しかし、解らなくともコードをコピペすれば再現だけはできる訳です。ただ再現時にちょっと面倒な部分があったので、それを自動化してみようと挑戦した次第です。その結果ちょっとゴチャゴチャした箇所ができたものの、自動的に処理できるようになりました(たぶん)。もっとスマートな方法があるのだろうか…今の知識ではこんなもんです。

 細々した処理の部分を丁寧に説明しようと試みたのですが、何だか説明を重ねる程に説明が解り難くなっていく気がします。言語能力高くありたい…

 最後まで読んでいただきありがとうございます。テキストマイニングっぽいことができたのではないでしょうか。またよろしくお願いします。年度中にもう1記事は書きたい!