un-stm.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# Topic modeling with quanteda and STM\n",
    "\n",
    "**Jupyter version of the [notebook](http://rpubs.com/cbpuschmann/un-stm) presented by Cornelius Puschmann.**\n",
    "\n",
    "This is a very quick implementation of topic modeling using [quanteda](https://quanteda.io/) and [STM](https://www.structuraltopicmodel.com/). The corpus used is the [UN General Debate Corpus](http://www.smikhaylov.net/ungdc/).\n",
    "\n",
    "A very good introduction to topic modeling with STM is provided in the STM vignette by Molly Roberts and colleagues. The code below closely follows the vignette.\n",
    "\n",
    "We begin by loading the two packages (install from CRAN if you don’t already have them)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "library(\"quanteda\")\n",
    "library(\"stm\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Next we load the data. The corpus is identical with the version stored in the Harvard Dataverse, but with some additional metadata. The data can be downloaded [here](https://www.dropbox.com/s/7lfca0nfupzwlyl/UNgeneraldebate.zip?dl=1)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "load(\"data/UNgeneraldebate.corpus.RData\")\n",
    "head(uncorpus.stats, 10)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now we calculate a document feature matrix (DFM), which is basically a table in which rows are texts and columns are words. We remove numbers, symbols, punctuation and standard English stop words and trim the DFM. Trimming in this case means both removing features which are rare (appearing in less that 7.5% of all documents) and ubiquitous (appearing in more than 90% of documents). Note that an untrimmed DFM will contain a lot of noise, slowing down processing without improving quality."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "uncorpus.dfm <- dfm(uncorpus, remove_numbers = TRUE, remove_punct = TRUE, remove_symbols = TRUE, remove = stopwords(\"english\"))\n",
    "uncorpus.dfm.trim <- dfm_trim(uncorpus.dfm, min_docfreq = 0.075, max_docfreq = 0.90, docfreq_type = \"prop\") # min 7.5% / max 95%\n",
    "uncorpus.dfm.trim"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We fit the STM model, here using a setting of k = 40 topics, and list the 10 terms with the highest topic probability for each topic.\n",
    "\n",
    "Note: we have prepared the data in advance and simply load it here, but run the commented function call below to see STM do its iterative magic. Spectral initialization makes the results reproducible."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "topic.count <- 40\n",
    "dfm2stm <- convert(uncorpus.dfm.trim, to = \"stm\")\n",
    "#model.stm <- stm(dfm2stm$documents, dfm2stm$vocab, K = topic.count, data = dfm2stm$meta, init.type = \"Spectral\") # this is the actual stm call\n",
    "load(\"data/UNgeneraldebate.stm.RData\")\n",
    "data.frame(t(labelTopics(model.stm, n = 10)$prob))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "\n",
    "Let’s plot a few heuristics. Note that these are [plot.STM](https://www.rdocumentation.org/packages/stm/versions/1.3.3/topics/plot.STM) custom plots included in the package. The plots show total topic share (a), topic constrast between two topics (b) and topic proportions within documents (c)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "plot(model.stm, type = \"summary\", text.cex = 0.5)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "plot(model.stm, type = \"perspectives\", topics = c(16,21)) # Topics #16 and #21"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "plot(model.stm, type = \"hist\", topics = sample(1:topic.count, size = 9))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "model.stm.labels <- labelTopics(model.stm, 1:topic.count)\n",
    "dfm2stm$meta$datum <- as.numeric(dfm2stm$meta$year)\n",
    "model.stm.ee <- estimateEffect(1:topic.count ~ country + s(year), model.stm, meta = dfm2stm$meta)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "par(mfrow=c(3,3))\n",
    "for (i in seq_along(sample(1:topic.count, size = 9)))\n",
    "{\n",
    "  plot(model.stm.ee, \"year\", method = \"continuous\", topics = i, main = paste0(model.stm.labels$prob[i,1:3], collapse = \", \"), printlegend = F)\n",
    "}"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "See below for plotting all 40 topics and saving the result to hard drive."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Plots of topic prevalence over time\n",
    "#png(width = 800, height = 800)\n",
    "#for (i in 1:topic.count)\n",
    "#{\n",
    "#  plot(model.stm.ee, \"year\", method = \"continuous\", topics = i, main = paste0(model.stm.labels$prob[i,1:3], collapse = \", \"), printlegend = F)\n",
    "#}\n",
    "#dev.off()"
   ]
  }
 ],
 "metadata": {
  "kernelspec": {
   "display_name": "R",
   "language": "R",
   "name": "ir"
  },
  "language_info": {
   "codemirror_mode": "r",
   "file_extension": ".r",
   "mimetype": "text/x-r-source",
   "name": "R",
   "pygments_lexer": "r",
   "version": "3.4.4"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 2
}