--- title: "Topic Modeling with R" author: "Martin Schweinberger" date: "`r format(Sys.time(), '%Y-%m-%d')`" output: bookdown::html_document2 bibliography: bibliography.bib link-citations: yes --- ```{r uq1, echo=F, fig.cap="", message=FALSE, warning=FALSE, out.width='100%'} knitr::include_graphics("https://slcladal.github.io/images/uq1.jpg") ``` # Introduction{-} This tutorial introduces topic modeling using R. ```{r diff, echo=FALSE, out.width= "15%", out.extra='style="float:right; padding:10px"'} knitr::include_graphics("https://slcladal.github.io/images/gy_chili.jpg") ``` This tutorial is aimed at beginners and intermediate users of R with the aim of showcasing how to perform basic topic modeling on textual data using R and how to visualize the results of such a model. The aim is not to provide a fully-fledged analysis but rather to show and exemplify selected useful methods associated with topic modeling.

The entire R Notebook for the tutorial can be downloaded [**here**](https://slcladal.github.io/content/topicmodels.Rmd). If you want to render the R Notebook on your machine, i.e. knitting the document to html or a pdf, you need to make sure that you have R and RStudio installed and you also need to download the [**bibliography file**](https://slcladal.github.io/content/bibliography.bib) and store it in the same folder where you store the Rmd file.

[![Binder](https://mybinder.org/badge_logo.svg)](https://mybinder.org/v2/gh/SLCLADAL/interactive-notebooks-environment/main?urlpath=git-pull%3Frepo%3Dhttps%253A%252F%252Fgithub.com%252FSLCLADAL%252Finteractive-notebooks%26urlpath%3Dlab%252Ftree%252Finteractive-notebooks%252Fnotebooks%252Ftopicmodels_cb.ipynb%26branch%3Dmain)
[**Click this link to open an interactive version of this tutorial on MyBinder.org**](https://mybinder.org/v2/gh/SLCLADAL/interactive-notebooks-environment/main?urlpath=git-pull%3Frepo%3Dhttps%253A%252F%252Fgithub.com%252FSLCLADAL%252Finteractive-notebooks%26urlpath%3Dlab%252Ftree%252Finteractive-notebooks%252Fnotebooks%252Ftopicmodels_cb.ipynb%26branch%3Dmain).
This interactive Jupyter notebook allows you to execute code yourself and you can also change and edit the notebook, e.g. you can change code and upload your own data.


This tutorial builds heavily on and uses materials from [this tutorial](https://tm4ss.github.io/docs/Tutorial_6_Topic_Models.html) on web crawling and scraping using R by Andreas Niekler and Gregor Wiedemann [see @WN17]. [The tutorial](https://tm4ss.github.io/docs/index.html) by Andreas Niekler and Gregor Wiedemann is more thorough, goes into more detail than this tutorial, and covers many more very useful text mining methods. an alternative and equally recommendable introduction to topic modeling with R is, of course, @silge2017text.

**Topic models aim to find topics (which are operationalized as bundles of correlating terms) in documents to see what the texts are about.**


Topic models are a common procedure in In machine learning and natural language processing. Topic models represent a type of statistical model that is use to discover more or less abstract *topics* in a given selection of documents. Topic models are particularly common in text mining to unearth hidden semantic structures in textual data. Topics can be conceived of as networks of collocation terms that, because of the co-occurrence across documents, can be assumed to refer to the same semantic domain (or topic). This assumes that, if a document is about a certain topic, one would expect words, that are related to that topic, to appear in the document more often than in documents that deal with other topics. For instance, *dog* and *bone* will appear more often in documents about dogs whereas *cat* and *meow* will appear in documents about cats. Terms like *the* and *is* will, however, appear approximately equally in both. Topic models are also referred to as probabilistic topic models, which refers to statistical algorithms for discovering the latent semantic structures of an extensive text body. Given the availability of vast amounts of textual data, topic models can help to organize and offer insights and assist in understanding large collections of unstructured text. ## Preparation and session set up{-} This tutorial is based on R. If you have not installed R or are new to it, you will find an introduction to and more information how to use R [here](https://slcladal.github.io/intror.html). For this tutorials, we need to install certain *packages* from an R *library* so that the scripts shown below are executed without errors. Before turning to the code below, please install the packages by running the code below this paragraph. If you have already installed the packages mentioned below, then you can skip ahead and ignore this section. To install the necessary packages, simply run the following code - it may take some time (between 1 and 5 minutes to install all of the packages so you do not need to worry if it takes some time). ```{r prep1, echo=T, eval = F, message=FALSE, warning=FALSE} # install packages install.packages("tm") install.packages("topicmodels") install.packages("reshape2") install.packages("ggplot2") install.packages("wordcloud") install.packages("pals") install.packages("SnowballC") install.packages("lda") install.packages("ldatuning") install.packages("kableExtra") install.packages("DT") install.packages("flextable") # install klippy for copy-to-clipboard button in code chunks install.packages("remotes") remotes::install_github("rlesur/klippy") ``` Next, we activate the packages. ```{r prep2, message=FALSE, warning=FALSE} # set options options(stringsAsFactors = F) # no automatic data transformation options("scipen" = 100, "digits" = 4) # suppress math annotation # load packages library(knitr) library(kableExtra) library(DT) library(tm) library(topicmodels) library(reshape2) library(ggplot2) library(wordcloud) library(pals) library(SnowballC) library(lda) library(ldatuning) library(flextable) # activate klippy for copy-to-clipboard button klippy::klippy() ``` Once you have installed R and RStudio and once you have initiated the session by executing the code shown above, you are good to go. # Topic Modelling{-} The process starts as usual with the reading of the corpus data. For this tutorial we will analyze *State of the Union Addresses* (SOTU) by US presidents and investigate how the topics that were addressed in the SOTU speeches changeover time. The 231 SOTU addresses are rather long documents. Documents lengths clearly affects the results of topic modeling. For very short texts (e.g. Twitter posts) or very long texts (e.g. books), it can make sense to concatenate/split single documents to receive longer/shorter textual units for modeling. For the SOTU speeches for instance, we infer the model based on paragraphs instead of entire speeches. By manual inspection / qualitative inspection of the results you can check if this procedure yields better (interpretable) topics. In `sotu_paragraphs.csv`, we provide a paragraph separated version of the speeches. For text preprocessing, we remove stopwords, since they tend to occur as "noise" in the estimated topics of the LDA model. ```{r tm2, message=FALSE, warning=FALSE} # load data textdata <- base::readRDS(url("https://slcladal.github.io/data/sotu_paragraphs.rda", "rb")) # load stopwords english_stopwords <- readLines("https://slcladal.github.io/resources/stopwords_en.txt", encoding = "UTF-8") # create corpus object corpus <- Corpus(DataframeSource(textdata)) # Preprocessing chain processedCorpus <- tm_map(corpus, content_transformer(tolower)) processedCorpus <- tm_map(processedCorpus, removeWords, english_stopwords) processedCorpus <- tm_map(processedCorpus, removePunctuation, preserve_intra_word_dashes = TRUE) processedCorpus <- tm_map(processedCorpus, removeNumbers) processedCorpus <- tm_map(processedCorpus, stemDocument, language = "en") processedCorpus <- tm_map(processedCorpus, stripWhitespace) ``` ## Model calculation{-} After the preprocessing, we have two corpus objects: `processedCorpus`, on which we calculate an LDA topic model [@blei2003lda]. To this end, *stopwords*, i.e. function words that have relational rather than content meaning, were removed, words were stemmed and converted to lowercase letters and special characters were removed. The second corpus object `corpus` serves to be able to view the original texts and thus to facilitate a qualitative control of the topic model results. We now calculate a topic model on the `processedCorpus`. For this purpose, a DTM of the corpus is created. In this case, we only want to consider terms that occur with a certain minimum frequency in the body. This is primarily used to speed up the model calculation. ```{r tm3a} # compute document term matrix with terms >= minimumFrequency minimumFrequency <- 5 DTM <- DocumentTermMatrix(processedCorpus, control = list(bounds = list(global = c(minimumFrequency, Inf)))) # have a look at the number of documents and terms in the matrix dim(DTM) # due to vocabulary pruning, we have empty rows in our DTM # LDA does not like this. So we remove those docs from the # DTM and the metadata sel_idx <- slam::row_sums(DTM) > 0 DTM <- DTM[sel_idx, ] textdata <- textdata[sel_idx, ] ``` As an unsupervised machine learning method, topic models are suitable for the exploration of data. The calculation of topic models aims to determine the proportionate composition of a fixed number of topics in the documents of a collection. It is useful to experiment with different parameters in order to find the most suitable parameters for your own analysis needs. For parameterized models such as Latent Dirichlet Allocation (LDA), the number of topics `K` is the most important parameter to define in advance. How an optimal `K` should be selected depends on various factors. If `K` is too small, the collection is divided into a few very general semantic contexts. If `K` is too large, the collection is divided into too many topics of which some may overlap and others are hardly interpretable. An alternative to deciding on a set number of topics is to extract parameters form a models using a rage of number of topics. This approach can be useful when the number of topics is not theoretically motivated or based on closer, qualitative inspection of the data. In the example below, the determination of the optimal number of topics follows @murzintcev2020idealtopics, but we only use two metrics (*CaoJuan2009* and *Deveaud2014*) - it is highly recommendable to inspect the results of the four metrics available for the `FindTopicsNumber` function (*Griffiths2004*, *CaoJuan2009*, *Arun2010*, and *Deveaud2014*). ```{r tm3b, message=FALSE, warning=FALSE} # create models with different number of topics result <- ldatuning::FindTopicsNumber( DTM, topics = seq(from = 2, to = 20, by = 1), metrics = c("CaoJuan2009", "Deveaud2014"), method = "Gibbs", control = list(seed = 77), verbose = TRUE ) ``` We can now plot the results. In this case, we have only use two methods *CaoJuan2009* and *Griffith2004*. The best number of topics shows low values for *CaoJuan2009* and high values for *Griffith2004* (optimally, several methods should converge and show peaks and dips respectively for a certain number of topics). ```{r tm3c, message=FALSE, warning=FALSE} FindTopicsNumber_plot(result) ``` For our first analysis, however, we choose a thematic "resolution" of `K = 20` topics. In contrast to a resolution of 100 or more, this number of topics can be evaluated qualitatively very easy. ```{r tm4} # number of topics K <- 20 # set random number generator seed set.seed(9161) # compute the LDA model, inference via 1000 iterations of Gibbs sampling topicModel <- LDA(DTM, K, method="Gibbs", control=list(iter = 500, verbose = 25)) ``` Depending on the size of the vocabulary, the collection size and the number K, the inference of topic models can take a very long time. This calculation may take several minutes. If it takes too long, reduce the vocabulary in the DTM by increasing the minimum frequency in the previous step. The topic model inference results in two (approximate) posterior probability distributions: a distribution `theta` over K topics within each document and a distribution `beta` over V terms within each topic, where V represents the length of the vocabulary of the collection (V = `r nTerms(DTM)`). Let's take a closer look at these results: ```{r tm5} # have a look a some of the results (posterior distributions) tmResult <- posterior(topicModel) # format of the resulting object attributes(tmResult) nTerms(DTM) # lengthOfVocab # topics are probability distributions over the entire vocabulary beta <- tmResult$terms # get beta from results dim(beta) # K distributions over nTerms(DTM) terms rowSums(beta) # rows in beta sum to 1 nDocs(DTM) # size of collection # for every document we have a probability distribution of its contained topics theta <- tmResult$topics dim(theta) # nDocs(DTM) distributions over K topics rowSums(theta)[1:10] # rows in theta sum to 1 ``` Let's take a look at the 10 most likely terms within the term probabilities `beta` of the inferred topics (only the first 8 are shown below). ```{r tm6} terms(topicModel, 10) ``` ```{r tm7} exampleTermData <- terms(topicModel, 10) exampleTermData[, 1:8] ``` For the next steps, we want to give the topics more descriptive names than just numbers. Therefore, we simply concatenate the five most likely terms of each topic to a string that represents a pseudo-name for each topic. ```{r tm8} top5termsPerTopic <- terms(topicModel, 5) topicNames <- apply(top5termsPerTopic, 2, paste, collapse=" ") ``` ## Visualization of Words and Topics{-} Although wordclouds may not be optimal for scientific purposes they can provide a quick visual overview of a set of terms. Let's look at some topics as wordcloud. In the following code, you can change the variable **topicToViz** with values between 1 and 20 to display other topics. ``` {r, fig.width=4, fig.height=4, fig.align='center', message=FALSE, warning=F} # visualize topics as word cloud topicToViz <- 11 # change for your own topic of interest topicToViz <- grep('mexico', topicNames)[1] # Or select a topic by a term contained in its name # select to 40 most probable terms from the topic by sorting the term-topic-probability vector in decreasing order top40terms <- sort(tmResult$terms[topicToViz,], decreasing=TRUE)[1:40] words <- names(top40terms) # extract the probabilites of each of the 40 terms probabilities <- sort(tmResult$terms[topicToViz,], decreasing=TRUE)[1:40] # visualize the terms as wordcloud mycolors <- brewer.pal(8, "Dark2") wordcloud(words, probabilities, random.order = FALSE, color = mycolors) ``` Let us now look more closely at the distribution of topics within individual documents. To this end, we visualize the distribution in 3 sample documents. Let us first take a look at the contents of three sample documents: ```{r tm9} exampleIds <- c(2, 100, 200) lapply(corpus[exampleIds], as.character) ``` ```{r tm10} exampleIds <- c(2, 100, 200) print(paste0(exampleIds[1], ": ", substr(content(corpus[[exampleIds[1]]]), 0, 400), '...')) print(paste0(exampleIds[2], ": ", substr(content(corpus[[exampleIds[2]]]), 0, 400), '...')) print(paste0(exampleIds[3], ": ", substr(content(corpus[[exampleIds[3]]]), 0, 400), '...')) ``` After looking into the documents, we visualize the topic distributions within the documents. ``` {r results="hide", warning=FALSE, message=FALSE, fig.width=10, fig.height=6, fig.align='center'} N <- length(exampleIds) # get topic proportions form example documents topicProportionExamples <- theta[exampleIds,] colnames(topicProportionExamples) <- topicNames vizDataFrame <- melt(cbind(data.frame(topicProportionExamples), document = factor(1:N)), variable.name = "topic", id.vars = "document") ggplot(data = vizDataFrame, aes(topic, value, fill = document), ylab = "proportion") + geom_bar(stat="identity") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + coord_flip() + facet_wrap(~ document, ncol = N) ``` ## Topic distributions{-} The figure above shows how topics within a document are distributed according to the model. In the current model all three documents show at least a small percentage of each topic. However, two to three topics dominate each document. The topic distribution within a document can be controlled with the *Alpha*-parameter of the model. Higher alpha priors for topics result in an even distribution of topics within a document. Low alpha priors ensure that the inference process distributes the probability mass on a few topics for each document. In the previous model calculation the alpha-prior was automatically estimated in order to fit to the data (highest overall probability of the model). However, this automatic estimate does not necessarily correspond to the results that one would like to have as an analyst. Depending on our analysis interest, we might be interested in a more peaky/more even distribution of topics in the model. Now let us change the alpha prior to a lower value to see how this affects the topic distributions in the model. ```{r tm11} # see alpha from previous model attr(topicModel, "alpha") ``` ```{r tm12} topicModel2 <- LDA(DTM, K, method="Gibbs", control=list(iter = 500, verbose = 25, alpha = 0.2)) tmResult <- posterior(topicModel2) theta <- tmResult$topics beta <- tmResult$terms topicNames <- apply(terms(topicModel2, 5), 2, paste, collapse = " ") # reset topicnames ``` Now visualize the topic distributions in the three documents again. What are the differences in the distribution structure? ``` {r results="hide", echo=T, warning=FALSE, message=FALSE, fig.width=10, fig.height=6, fig.align='center'} # get topic proportions form example documents topicProportionExamples <- theta[exampleIds,] colnames(topicProportionExamples) <- topicNames vizDataFrame <- melt(cbind(data.frame(topicProportionExamples), document = factor(1:N)), variable.name = "topic", id.vars = "document") ggplot(data = vizDataFrame, aes(topic, value, fill = document), ylab = "proportion") + geom_bar(stat="identity") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) + coord_flip() + facet_wrap(~ document, ncol = N) ``` ## Topic ranking{-} First, we try to get a more meaningful order of top terms per topic by re-ranking them with a specific score [@Chang2009]. The idea of re-ranking terms is similar to the idea of TF-IDF. The more a term appears in top levels w.r.t. its probability, the less meaningful it is to describe the topic. Hence, the scoring advanced favors terms to describe a topic. ```{r tm13} # re-rank top topic terms for topic names topicNames <- apply(lda::top.topic.words(beta, 5, by.score = T), 2, paste, collapse = " ") ``` What are the defining topics within a collection? There are different approaches to find out which can be used to bring the topics into a certain order. ### Approach 1{-} We sort topics according to their probability within the entire collection: ```{r tm14} # What are the most probable topics in the entire collection? topicProportions <- colSums(theta) / nDocs(DTM) # mean probabilities over all paragraphs names(topicProportions) <- topicNames # assign the topic names we created before sort(topicProportions, decreasing = TRUE) # show summed proportions in decreased order ``` ```{r tm15} soP <- sort(topicProportions, decreasing = TRUE) paste(round(soP, 5), ":", names(soP)) ``` We recognize some topics that are way more likely to occur in the corpus than others. These describe rather general thematic coherence. Other topics correspond more to specific contents. ### Approach 2{-} We count how often a topic appears as a primary topic within a paragraph This method is also called Rank-1. ```{r tm16} countsOfPrimaryTopics <- rep(0, K) names(countsOfPrimaryTopics) <- topicNames for (i in 1:nDocs(DTM)) { topicsPerDoc <- theta[i, ] # select topic distribution for document i # get first element position from ordered list primaryTopic <- order(topicsPerDoc, decreasing = TRUE)[1] countsOfPrimaryTopics[primaryTopic] <- countsOfPrimaryTopics[primaryTopic] + 1 } sort(countsOfPrimaryTopics, decreasing = TRUE) ``` ```{r tm17} so <- sort(countsOfPrimaryTopics, decreasing = TRUE) paste(so, ":", names(so)) ``` We see that sorting topics by the Rank-1 method places topics with rather specific thematic coherences in upper ranks of the list. This sorting of topics can be used for further analysis steps such as the semantic interpretation of topics found in the collection, the analysis of time series of the most important topics or the filtering of the original collection based on specific sub-topics. ## Filtering documents{-} The fact that a topic model conveys of topic probabilities for each document, resp. paragraph in our case, makes it possible to use it for thematic filtering of a collection. AS filter we select only those documents which exceed a certain threshold of their probability value for certain topics (for example, each document which contains topic `X` to more than 20 percent). In the following, we will select documents based on their topic content and display the resulting document quantity over time. ```{r tm18} topicToFilter <- 6 # you can set this manually ... # ... or have it selected by a term in the topic name (e.g. 'children') topicToFilter <- grep('children', topicNames)[1] topicThreshold <- 0.2 selectedDocumentIndexes <- which(theta[, topicToFilter] >= topicThreshold) filteredCorpus <- corpus[selectedDocumentIndexes] # show length of filtered corpus filteredCorpus ``` Our filtered corpus contains `r length(filteredCorpus)` documents related to the topic `r topicToFilter` to at least 20 %. ## Topic proportions over time{-} In a last step, we provide a distant view on the topics in the data over time. For this, we aggregate mean topic proportions per decade of all SOTU speeches. These aggregated topic proportions can then be visualized, e.g. as a bar plot. ```{r fig.width=9, fig.height=6, fig.align='center', warning=F, message=F} # append decade information for aggregation textdata$decade <- paste0(substr(textdata$date, 0, 3), "0") # get mean topic proportions per decade topic_proportion_per_decade <- aggregate(theta, by = list(decade = textdata$decade), mean) # set topic names to aggregated columns colnames(topic_proportion_per_decade)[2:(K+1)] <- topicNames # reshape data frame vizDataFrame <- melt(topic_proportion_per_decade, id.vars = "decade") # plot topic proportions per decade as bar plot ggplot(vizDataFrame, aes(x=decade, y=value, fill=variable)) + geom_bar(stat = "identity") + ylab("proportion") + scale_fill_manual(values = paste0(alphabet(20), "FF"), name = "decade") + theme(axis.text.x = element_text(angle = 90, hjust = 1)) ``` The visualization shows that topics around the relation between the federal government and the states as well as inner conflicts clearly dominate the first decades. Security issues and the economy are the most important topics of recent SOTU addresses. # Citation & Session Info {-} Schweinberger, Martin. `r format(Sys.time(), '%Y')`. *Topic Modeling with R*. Brisbane: The University of Queensland. url: https://slcladal.github.io/topicmodels.html (Version `r format(Sys.time(), '%Y.%m.%d')`). ``` @manual{schweinberger`r format(Sys.time(), '%Y')`topic, author = {Schweinberger, Martin}, title = {Topic Modeling with R}, note = {https://slcladal.github.io/topicmodels.html}, year = {`r format(Sys.time(), '%Y')`}, organization = "The University of Queensland, Australia. School of Languages and Cultures}, address = {Brisbane}, edition = {`r format(Sys.time(), '%Y.%m.%d')`} } ``` ```{r fin} sessionInfo() ``` *** [Back to top](#introduction) [Back to HOME](https://slcladal.github.io/index.html) *** # References{-}