Lecture10: Topic Modeling

今日の参考資料

* 小林雄一郎(2017)「Rによるやさしいテキストマイニング[機械学習編]」オーム社

* Wayne Weiai Xu (2017), What Do Twitter Users Talk About Mindhunter (2016)? - Leverage Topic Modeling for Textual Insights: https://rpubs.com/cosmopolitanvan/topicmodeling

LDAのための必要なパッケージをダウンロード

install.packages("lda", dependencies = TRUE)
install.packages("topicmodels", dependencies = TRUE)
install.packages("LDAvis", dependencies = TRUE)

ldaパッケージ

1テキストのみ使用した例

テキストの処理

Alice.text <- scan("alice.txt", what="char", sep="\n", quiet=TRUE) %>% str_to_lower() 
head(Alice.text)
Alice.wordLst <- Alice.text %>% strsplit("[[:space:]]|[[:punct:]]") %>% unlist()
Alice.wordLst.cleaned <- Alice.wordLst %>% removeNumbers() %>% removeWords(stopwords("english"))
Alice.wordLst.cleaned <- Alice.wordLst.cleaned[Alice.wordLst.cleaned!=""]
Alice.wordLst.cleaned[1:100]

LDA用のデータ形式

lex <- lexicalize(Alice.wordLst.cleaned)
summary(lex)

トピックの推定

k=10
alpha =0.01
eta =  0.01
lda.result <- lda.collapsed.gibbs.sampler(documents = lex$documents, K = k, vocab = lex$vocab, num.iterations = 300, alpha = 0.2, eta = 0.2)

各トピックに含まれる単語（上位10語を抽出）

top.words <- top.topic.words(lda.result$topics, 10, by.score=TRUE)
head(top.words)

---

topicmodelsパッケージみ使用した例

関連ライブラリの読み込み

library(topicmodels)
library(tm)
library(dplyr)
library(stringi)

univディレクトリの読み込み->テキストの整形

dirName="univ"
corpus <- Corpus(DirSource(dirName, encoding="UTF-8"), readerControl=list(langage="en"))
corpus.cleaned <- corpus %>% tm_map(str_to_lower) %>% tm_map(removePunctuation) %>% tm_map(removeNumbers) %>% tm_map(removeWords, stopwords("english")) %>% tm_map(stripWhitespace)

文書-ターム行列の作成

dtm <- DocumentTermMatrix(corpus.cleaned)

トピックの推定(Gibbs推定法)

k = 5
lda.result <-LDA(dtm,k, method="Gibbs")

各トピックを特徴付ける単語

terms(lda.result,10)

各文書におけるのトピックの比率

posterior(lda.result)[[2]]

トピックの推定(Variational Expectation-Maximization: VEM推定法)

k = 5
lda.result_VEM <-LDA(dtm,k)

各トピックを特徴付ける単語

terms(lda.result_VEM,10)

各文書におけるのトピックの比率

posterior(lda.result_VEM)[[2]]

描画用パッケージ

ライブラリの読み込み

library(LDAvis)
library(servr)

topicmodels2LDAvis関数の利用

https://rpubs.com/cosmopolitanvan/topicmodeling

topicmodels2LDAvis <- function(x, ...){
  post <- topicmodels::posterior(x)
  if (ncol(post[["topics"]]) < 3) stop("The model must contain > 2 topics")
  mat <- x@wordassignments
  LDAvis::createJSON(
    phi = post[["terms"]], 
    theta = post[["topics"]],
    vocab = colnames(post[["terms"]]),
    doc.length = slam::row_sums(mat, na.rm = TRUE),
    term.frequency = slam::col_sums(mat, na.rm = TRUE)
  )
}

ブラウザ上に描画:Gibbs推定の結果

serVis(topicmodels2LDAvis(lda.result),open.browser=TRUE)

ブラウザ上に描画:VEM推定の結果

serVis(topicmodels2LDAvis(lda.result_VEM),open.browser=TRUE)

InauguralAddressディレクトリ

dirName="InauguralAddress"
corpus <- Corpus(DirSource(dirName, encoding="UTF-8"), readerControl=list(langage="en"))
corpus.cleaned <- corpus %>% tm_map(str_to_lower) %>% tm_map(removePunctuation) %>% tm_map(removeNumbers) %>% tm_map(removeWords, stopwords("english")) %>% tm_map(stripWhitespace)

dtm <- DocumentTermMatrix(corpus.cleaned)

k = 7
lda.result <-LDA(dtm,k, method="Gibbs")

serVis(topicmodels2LDAvis(lda.result),open.browser=TRUE)

各トピックを特徴付ける単語

terms(lda.result,10)

各文書におけるのトピックの比率

posterior(lda.result)[[2]]