CH6 Topic modeling

library(dplyr)
library(data.table)
library(ggplot2)

#install.packages('topicmodels')

6.1 Latent Dirichlet allocation

library(topicmodels)

data("AssociatedPress")
AssociatedPress

# set a seed so that the output of the model is predictable
ap_lda <- LDA(AssociatedPress, k = 2, control = list(seed = 1234))
ap_lda

6.1.1 Word-topic probabilities

library(tidytext)

ap_topics <- tidy(ap_lda, matrix = "beta")
ap_topics

library(ggplot2)
library(dplyr)

ap_top_terms <- ap_topics %>%
  group_by(topic) %>%
  top_n(10, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

ap_top_terms %>%
  mutate(term = reorder(term, beta)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip()

library(tidyr)

beta_spread <- ap_topics %>%
  mutate(topic = paste0("topic", topic)) %>%
  spread(topic, beta) %>%
  filter(topic1 > .001 | topic2 > .001) %>%
  mutate(log_ratio = log2(topic2 / topic1))

beta_spread

6.1.2 Document-topic probabilities

ap_documents <- tidy(ap_lda, matrix = "gamma")
ap_documents

tidy(AssociatedPress) %>%
  filter(document == 6) %>%
  arrange(desc(count))

6.2 Example: the great library heist

lyric_data=fread('../data/prince_raw_data.csv')

lyric_data %>% 
  group_by(album) %>%
  summarise(
    count=n()
  ) %>%
  as.data.frame %>%
  .[order(.$count,decreasing=T),]

albums=c('Other Songs','Crystal Ball','Emancipation','Rave Un2 the Joy Fantastic')

library(stringr)

# divide into documents, each representing one chapter
by_album <- lyric_data[,1:6] %>%
  filter(album %in% albums) %>%
  group_by(album) %>%
  mutate(linenumber=row_number()) %>%
  ungroup() %>%
  unite(document, album)

# split into words
by_album_word <- by_album %>%
  unnest_tokens(word, text)

# find document-word counts
word_counts <- by_album_word %>%
  anti_join(stop_words) %>%
  count(document, word, sort = TRUE) %>%
  ungroup()

word_counts

6.2.1 LDA on albums

albums_dtm <- word_counts %>%
  cast_dtm(document, word, n)

albums_dtm

albums_lda <- LDA(albums_dtm, k = 4, control = list(seed = 1234))
albums_lda

album_topics <- tidy(albums_lda, matrix = "beta")
album_topics

top_terms <- album_topics %>%
  group_by(topic) %>%
  top_n(5, beta) %>%
  ungroup() %>%
  arrange(topic, -beta)

top_terms

library(ggplot2)

top_terms %>%
  mutate(term = reorder(term, beta)) %>%
  ggplot(aes(term, beta, fill = factor(topic))) +
  geom_col(show.legend = FALSE) +
  facet_wrap(~ topic, scales = "free") +
  coord_flip()

6.2.2 Per-document classification

albums_gamma <- tidy(albums_lda, matrix = "gamma")
albums_gamma

names(albums_gamma)[1]='album'
names(albums_gamma)

# reorder albums in order of topic 1, topic 2, etc before plotting
albums_gamma %>%
  mutate(album = reorder(album, gamma * topic)) %>%
  ggplot(aes(factor(topic), gamma)) +
  geom_boxplot() +
  facet_wrap(~ album)

6.3 Alternative LDA implementations

#install.packages('mallet')
library(mallet)

# create a vector with one string per chapter
collapsed <- by_album_word %>%
  anti_join(stop_words, by = "word") %>%
  mutate(word = str_replace(word, "'", "")) %>%
  group_by(document) %>%
  summarize(text = paste(word, collapse = " "))

# create an empty file of "stopwords"
file.create(empty_file <- tempfile())
docs <- mallet.import(collapsed$document, collapsed$text, empty_file)

mallet_model <- MalletLDA(num.topics = 4)
mallet_model$loadDocuments(docs)
mallet_model$train(100)

# word-topic pairs
tidy(mallet_model)

# document-topic pairs
tidy(mallet_model, matrix = "gamma")

# column needs to be named "term" for "augment"
term_counts <- rename(word_counts, term = word)
augment(mallet_model, term_counts)