06_Text_Analysis.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "<center> <img style=\"float: center;\" src=\"images/CI_horizontal.png\" width=\"450\">\n",
    "<center>\n",
    "    <span style=\"font-size: 1.5em;\">\n",
    "        <a href='https://www.coleridgeinitiative.org'>Website</a>\n",
    "    </span> "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# <center>Text Analysis</center>\n",
    "<br>\n",
    "<center>Brian Kim, Maryah Garner, Ekaterina Levitskaya, Rukhshan Arif Mian</center>\n",
    "<br>\n",
    "<a href=\"https://doi.org/10.5281/zenodo.6463897\"><img src=\"https://zenodo.org/badge/DOI/10.5281/zenodo.6463897.svg\" alt=\"DOI\"></a>\n",
    "\n",
    "\n",
    "## Introduction"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Text analysis is used to extract useful information from or summarize a large amount of unstructured text stored in documents. This opens up the opportunity to use text data alongside more conventional data sources (e.g. surveys and administrative data). The goal of text analysis is to take a large corpus of complex and unstructured text data and extract important and meaningful messages in a comprehensible way. \n",
    "\n",
    "Text analysis can help with the following tasks:\n",
    "\n",
    "* **Information Retrieval**: Find relevant information in a large database, such as a systematic literature review, that would be very time-consuming for humans to do manually. \n",
    "\n",
    "* **Clustering and Text Categorization**: Summarize a large corpus of text by finding the most important phrases, using methods such as topic modeling. \n",
    "\n",
    "* **Text Summarization**: Create category-sensitive text summaries of a large corpus of text. \n",
    "\n",
    "* **Machine Translation**: Translate documents from one language to another. \n",
    "\n",
    "This notebook covers the analysis of grant abstracts using topic modeling to examine the content of the data and document classification for tagging academic discipline in the abstracts. \n",
    "\n",
    "## Learning Outcomes\n",
    "\n",
    "* Learn how to transform a corpus of text into a structured matrix format to apply natural language processing (NLP) methods\n",
    "* Learn the basics and applications of topic modeling\n",
    "* Learn how to do document tagging and evaluate the results\n",
    "\n",
    " \n",
    "## Glossary of Terms\n",
    "\n",
    "Glossary of Terms:\n",
    "\n",
    "* **Corpus**: A corpus is the set of all text documents used in an analysis; for example, a corpus of text may include hundreds of research articles.\n",
    "\n",
    "* **Tokenization**: Tokenization is the process by which text is separated into meaningful terms or phrases. In English, this is easy to do for individual words, as they are separated by whitespace; however, it can get more complicated to  automate determining which groups of words constitute meaningful phrases. \n",
    "\n",
    "* **Stemming**: Stemming is normalizing text by reducing all forms or conjugations of a word to the word's most basic form. In English, this can mean making a rule of removing the suffixes \"ed\" or \"ing\" from the end of all words, but it gets more complex. For example, \"to go\" is irregular, so the algorithm needs to know that \"went\" and \"goes\" stem from a common lemma and should be considered alternate forms of the word \"go.\"\n",
    "\n",
    "* **TF-IDF**: TF-IDF (term frequency-inverse document frequency) is an example of feature engineering where the most important words are extracted by taking account of their frequency in documents and the entire corpus of documents as a whole.\n",
    "\n",
    "* **Topic Modeling**: Topic modeling is an unsupervised learning method where groups of words that often appear together are clustered into topics. Typically, the words in one topic should be related and make sense (e.g. boat, ship, captain). Individual documents can fall under one topic or multiple topics. \n",
    "\n",
    "* **LDA**: LDA (Latent Dirichlet Allocation) is a type of probabilistic model commonly used for topic modeling. \n",
    "\n",
    "* **Stop Words**: Stop words are words that have little semantic meaning but occur very frequently, like prepositions, articles and common nouns. For example, every document (in English) will probably contain the words \"and\" and \"the\" many times. These will often be removed as part of preprocessing using a list of stop words.\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Setup\n",
    "\n",
    "This notebook uses a set of external R packages for the text analysis. Besides the usual data manipulation and database connection packages, another package called `tidytext` is also used, which contains useful functions for cleaning text data, and is designed to work within the `tidyverse` structure. In addition, the `topicmodels` package helps run the Latent Dirichlet Allocation (LDA) topic modeling algorithm, and `SnowballC` does the same for stemming."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "options(warn=-1)\n",
    "# database interaction imports\n",
    "suppressMessages(library(odbc))\n",
    "\n",
    "# for data manipulation/visualization\n",
    "suppressMessages(library(tidyverse))\n",
    "\n",
    "# tidytext for cleaning text data\n",
    "suppressMessages(library(tidytext))\n",
    "\n",
    "# Stemming\n",
    "suppressMessages(library(SnowballC))\n",
    "\n",
    "# topicmodels for LDA\n",
    "suppressMessages(library(topicmodels))\n",
    "\n",
    "options(warn=0)\n",
    "# For easier viewing of graphs\n",
    "theme_set(theme_gray(base_size = 24))\n",
    "options(repr.plot.width = 16, repr.plot.height = 12)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Motivation: Grant Abstracts\n",
    "\n",
    "The data in this class include the grant abstracts for grants in the UMETRICS data, containing information about NIH, NSF, and USDA grants. Here, text analysis techniques on the grant proposal abstracts are used to classify these abstracts into sets of topics. Note that there is not a pre-compiled list of topics that is being matched to the abstracts. Instead, the focus is on exploring the data and using unsupervised learning in order to generate the topics.\n",
    "\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Establishing a connection"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Connect to the database\n",
    "con <- DBI::dbConnect(odbc::odbc(),\n",
    "                     Driver = \"SQL Server\",\n",
    "                     Server = \"msssql01.c7bdq4o2yhxo.us-gov-west-1.rds.amazonaws.com\",\n",
    "                     Trusted_Connection = \"True\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Load the Data"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The following code cells load the data (the abstracts of grant proposals from 2 agencies: NSF and USDA) into a data frame from the database. The query itself is complex even though we are pulling in two columns from one table: **unique_award_number** and **abstract**. This complexity arises as a result of the following:\n",
    "\n",
    "1. We would like to see <u>abstracts</u> for each <u>NSF</u>  <u>award</u> for our 2015 SED cohort. \n",
    "2. The SED table is called to only keep the 2015 cohort (`sed.phdfy = '2015'`)\n",
    "3. A join with the `core_employee` table is performed to get the **unique_award_number** associated with doctorate students in our cohort\n",
    "4. The **unique_award_number** is used to then join with the `umetrics_nsf_grants` table \n",
    "5. The final table now has NSF award-level information with each award's associated abstract – based on the steps above, this table is only for doctorate students (from SED) who graduated in 2015 (`phdfy`= '2015') and received some sort of funding (so that they appear in the `core_employee` table)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Get NSF grants\n",
    "qry <- \"\n",
    "SELECT DISTINCT award.unique_award_number, abstract\n",
    "FROM ds_nsf_ncses.dbo.nsf_sed sed\n",
    "JOIN tr_ncses_2021.dbo.sed_umetrics_xwalk xwalk \n",
    "ON sed.drf_id = xwalk.drf_id\n",
    "LEFT JOIN ds_iris_umetrics.dbo.core_employee award\n",
    "ON xwalk.emp_number = award.emp_number\n",
    "JOIN ds_iris_umetrics.dbo.umetrics_nsf_grants nsf\n",
    "ON award.unique_award_number = nsf.unique_award_number AND award.institution_id = nsf.institution_id\n",
    "WHERE sed.phdfy = '2015' and award.period_start_date <= '2015-12-31';\n",
    "\"\n",
    "\n",
    "nsf_text <- dbGetQuery(con, qry)\n",
    "# view the first observation\n",
    "head(nsf_text,1)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The number of NSF grants the cohort received can be found using `nrow()`."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# number of NSF grants\n",
    "nrow(nsf_text)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Because `nsf_text` is eventually combined with all of the USDA grants for this cohort, an agency-level identifier can be added to `nsf_text` as the variable **agency**. All rows in `nsf_text` take on a value of **NSF** since they are all grants from NSF."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# create NSF agency identifier\n",
    "nsf_text$agency <- 'NSF'"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The USDA grants for the 2015 cohort are also read into R, this time saved as `usda_text`. We re-use the steps that we utilized for `nsf_text` – the only difference here is that we are reading in USDA awards data as opposed to NSF awards."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# get USDA grants\n",
    "qry <- \"\n",
    "SELECT DISTINCT award.unique_award_number, abstract\n",
    "FROM ds_nsf_ncses.dbo.nsf_sed sed\n",
    "JOIN tr_ncses_2021.dbo.sed_umetrics_xwalk xwalk \n",
    "ON sed.drf_id = xwalk.drf_id\n",
    "LEFT JOIN ds_iris_umetrics.dbo.core_employee award\n",
    "ON xwalk.emp_number = award.emp_number\n",
    "JOIN ds_iris_umetrics.dbo.umetrics_usda_grants usda\n",
    "ON award.unique_award_number = usda.unique_award_number AND award.institution_id = usda.institution_id\n",
    "WHERE sed.phdfy = '2015' and award.period_start_date <= '2015-12-31';\n",
    "\"\n",
    "\n",
    "usda_text <- dbGetQuery(con, qry)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The number of USDA grants the cohort received can be found in the same way as above."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# number of USDA grants\n",
    "nrow(usda_text)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Before combining all of the USDA and NSF grants for this cohort together, the agency-specific identifier must also be added to `usda_text`."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# create usda agency identifier\n",
    "usda_text$agency <- 'USDA'"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "These two sets of grants, stored in `nsf_text` and `usda_text`, can be combined together using `rbind()`. \n",
    "\n",
    "> The `rbind()` function in R, is short for Row-Bind. It is used to combine vectors, metraces and data frames.  In order for `rbind()` to work properly, the column names of the data frames must be the same."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# combine rows from nsf_text and usda_text\n",
    "abstracts <- rbind(nsf_text, usda_text)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "To confirm that `rbind()` worked as expected, the number of total USDA and NSF grants received for this cohort can also be found."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# see total number of rows after combining nsf_text and usda_text\n",
    "nrow(abstracts)\n",
    "\n",
    "# check to see if the total number of rows is equal to the sum of the rows from the two data frames\n",
    "nrow(nsf_text) + nrow(usda_text) # this should be equivalent to the what runs above "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Preparing Text Data for Natural Language Processing (NLP)\n",
    "\n",
    "The first important step in working with text data is cleaning and processing the data, which includes (but is not limited to):\n",
    "- forming a corpus of text\n",
    "- stemming and lemmatization\n",
    "- tokenization\n",
    "- removing stop words\n",
    "- finding words co-located together (N-grams)\n",
    "\n",
    "The ultimate goal is to transform the text data into a form in which an algorithm can be deployed, because a document or a corpus of text cannot be fed directly into an algorithm. Algorithms expect numerical feature vectors with certain fixed sizes, and cannot handle documents, which are effectively sequences of symbols with variable length. To morph a document into a classic data frame, the text corpus can be transfomed into a _bag of tokens_ (also known as a bag of words) to be further analyzed. In this form, the text data is represented as a matrix where each row refers to a specific grant abstract (document) and each column is the occurence of a word (feature)."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The matrix would look something like this: \n",
    "\n",
    "|doc# / unique words | 'science' | 'research' | 'cell' | 'DNA' | 'gene' |\n",
    "|-----------|--------|---------|-------|-------|------|\n",
    "|document 1 |    0   |    0    |   1   |   5   |  7   |\n",
    "|document 2 |    1   |    2    |   0   |   1   |  0   |\n",
    "|document 3 |    1   |    5    |   2   |   0   |  0   |\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Tokenizing"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "First, the text must be separated into individual tokens (generally, individual words). The `unnest_tokens` function can be used to **tokenize**, or separate out the paragraph into individual words."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# try unnest_tokens()\n",
    "abstracts %>% \n",
    "# split up each abstract into individual words\n",
    "    unnest_tokens(word, abstract) %>% \n",
    "# view the first 6 observations\n",
    "    head()"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Currently, the `abstracts` data frame has one row per abstract. The `unnest_tokens` function split up each of those abstracts into individual words, then made each word its own row for that abstract, so now each abstract has as many rows as it has words. However, it is important to aggregate it up, because there are repeat words. This aggregation can be done using `count`. "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### Count the amount of times each word was used in an abstract"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# count amount of times each word was used in an abstract\n",
    "abstracts %>% \n",
    "# split up each abstract into individual words\n",
    "    unnest_tokens(word, abstract) %>%\n",
    "# aggergate and count all of the words within each unique award\n",
    "    count(unique_award_number, word) %>% \n",
    "    head()"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "There are a lot of common English words that do not really add much to the topic of the abstract. These are called stop words, which can be removed."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Removing meaningless text - Stopwords"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Stopwords are words that are found commonly throughout a text and carry little semantic meaning. Examples of common stopwords are prepositions (\"to\", \"on\", \"in\"), articles (\"the\", \"an\", \"a\"), conjunctions (\"and\", \"or\", \"but\") and common nouns. For example, the words _the_ and _of_ are ubiquitous, so they will not serve as meaningful features, whether to distinguish documents from each other or to describe a given document. There also could be words that need to be removed based on where the corpus of text was obtained or its topic. There are many lists of common stopwords available for public use, both for general documents and for specific contexts, so there is no need to start from scratch.\n",
    "\n",
    "Stopwords can be eliminated by checking all the words in the corpus against a list of commonly occuring stopwords that can be found courtesy of the `get_stopwords` function from the `tidytext` package. To get rid of all the stopwords in `get_stopwords` that occur in `abstracts`, an `anti_join` is used. \n",
    "> The `anti_join` function returns all rows from _x_ (first table) without a match in _y_ (second table)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "abstracts %>% \n",
    "# split up each abstract into individual words\n",
    "    unnest_tokens(word, abstract) %>% \n",
    "# remove stopwords\n",
    "    anti_join(get_stopwords()) %>% \n",
    "# aggergate and count all of the words within each unique award\n",
    "    count(unique_award_number, word) %>%\n",
    "# view the first 6 observations\n",
    "    head()"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Stemming and Lemmatization - Distilling text data\n",
    "\n",
    "Text can be processed through _stemming and lemmatization_, or replacing words with their root or simplest form. For example, \"systems\", \"systematic\", and \"system\" are all different words, but all these words can be replaced with \"system\" without sacrificing much meaning. \n",
    "- A **lemma** is the original dictionary form of a word (e.g. the lemma for \"lies\", \"lied\", and \"lying\" is \"lie\").\n",
    "- The process of turning a word into its simplest form is **stemming**. There are several well-known stemming algorithms -- Porter, Snowball, Lancaster - that all have their respective strengths and weaknesses.\n",
    "\n",
    "This section includes an example of the Snowball Stemmer, using `mutate` to replace the **word** column with the stemmed version of that column. The data frame that results from the Snowball Stemmer is piped into `ggplot` to visualize the most common words in the documents."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# graph most common stems\n",
    "abstracts %>% \n",
    "# split up each abstract into individual words\n",
    "    unnest_tokens(word, abstract) %>% \n",
    "# remove stopwords\n",
    "    anti_join(get_stopwords()) %>% \n",
    "# get the stem of the word \n",
    "    mutate(word = wordStem(word)) %>%\n",
    "# aggergate and count all words across all awards then sort the data in decenting order\n",
    "    count(word, sort = TRUE) %>% \n",
    "# select the top to words\n",
    "    head(10) %>% \n",
    "# make a horizontial bar graph\n",
    "    ggplot(aes(y = reorder(word, n), x = n)) + \n",
    "    geom_col()"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Topic Modeling\n",
    "Topic modeling, an unsupervised learning method, can be applied to a corpus to discern the high-level topics in the corpus. The discussion of the choices being cleaning and preprocessing data to get the best results permeates throughout this process. Topic modeling is a broad subfield of machine learning and natural language processing. This notebook focuses on a common modeling approach called Latent Dirichlet Allocation (LDA).\n",
    "\n",
    "In topic modeling, the first assumption is that topics exist in the given corpus, and that some small number of these topics can \"explain\" the corpus. Topics in this context refer to words from the corpus, in a list that is ranked by probability. A single document can be explained by multiple topics. For instance, an article on net neutrality would fall under the topic \"technology\" as well as the topic \"politics\". The set of topics used by a document is known as the document's allocation, hence the name Latent Dirichlet Allocation, and each document has an allocation of latent topics allocated by Dirichlet distribution. Latent (or hidden) stands for topics in the documents that are existing but not yet developed or manifested and can be discovered based on observed data, such as words in the documents. Dirichlet refers to distributions that are taken into account when creating topics: a distribution of words in the topic (which words are more or less probable to belong to a given topic) and a distribution of topics in documents (which topic is more or less probable for a given document). \n",
    "\n",
    "In this notebook, topic modeling is used in order to determine the types of research based on the grants' abstracts."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### Find token counts by abstract"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "abstract_tokens <- abstracts %>%\n",
    "# split up each abstract into individual words\n",
    "    unnest_tokens(word, abstract) %>% \n",
    "# remove stopwords\n",
    "    anti_join(get_stopwords()) %>% \n",
    "# get the stem of the word \n",
    "    mutate(word = wordStem(word)) %>%\n",
    "# aggergate and count all of the words within each unique award\n",
    "    count(unique_award_number, word)\n",
    "\n",
    "head(abstract_tokens)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## TF-IDF - Weighting terms based on frequency"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "A final step in cleaning and processing text data is **Term Frequency-Inverse Document Frequency (TF-IDF)**. TF-IDF is based on the idea that the words (or terms) that are most related to a certain topic will occur frequently in documents on that topic, and infrequently in unrelated documents. TF-IDF re-weights words so that words that are unique to a document are emphasized and words that are common throughout the corpus are suppressed by inversely weighting terms based on their frequency within the document and across the corpus.\n",
    "\n",
    "The `bind_tf_idf` function can calculate the TF-IDF on a bag of words object in R, which in this case is `abstract_tokens`. `bind_tf_idf` takes on three additional arguments: the name of the column for (1) the word (**word**), (2) the document (**unique_award_number**) and (3) the count (**n**)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# calculate tf-idf\n",
    "award_words <- abstract_tokens %>%\n",
    "    bind_tf_idf(word, unique_award_number, n)\n",
    "\n",
    "# view the first 2 rows\n",
    "head(award_words,2)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "A very specific type of object called a Document Term Matrix is needed in order to do topic modeling. This is a way of more efficiently storing the very sparse text matrix. Since most documents will only have a small subset of all possible words, the vast majority of entries in the matrix will be 0. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# save as a document-term matrix\n",
    "award_dtm <- award_words %>%\n",
    "    cast_dtm(unique_award_number, word, n)\n",
    "\n",
    "# see info for the document term matrix\n",
    "award_dtm"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Latent Dirichlet Allocation"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Latent Dirichlet Allocation (LDA) is a statistical model that generates groups based on similarities. This is an example of an **unsupervised machine learning model**. That is, there is no outcome variable - topic modeling is about grouping the abstracts into rough categories."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Fitting an LDA model in R is very similar to the model fitting in Python's `sklearn` package. First a `LatentDirichletAllocation` object must be created, and afterwards, it must be fit using the corpus bag of words."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "By default, the LDA model can produce different results every time it is run, because every time it starts with a different random seed. In order to stabilize the outputs of the topic model, the seed can be specified using the `control=list(seed=0)` parameter in the LDA function. Then, every time the LDA model is run with this specified seed, it produces the same allocation of topics and words."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The different numbers of topics should be tested to see which ones would be best. The example below includes 7 topics.\n",
    "\n",
    "**Note: This code might take a while to run**"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# run and lda model with 7 topics\n",
    "award_lda <- LDA(award_dtm, 7, control=list(seed=0))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The `LDA` function from `topicmodels` runs the LDA model on `award_lda`. The `tidytext` package has some nice tools for working with the LDA topic model object, such as the `tidy` function. This can be used to extract the per-topic-per-word probabilities, which are denoted by $\\beta$."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# extract per-topic-per-word probabilities\n",
    "award_topics <- tidy(award_lda, matrix = 'beta')"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "#### Find the 10 most common words per topic\n",
    "Now that the per-topic-per-word probabilities have been calculated, these word probabilities can be grouped by topic to find the 10 most common words within each topic using the `top_n` function. This data frame can then be graphed using a bar plot."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "award_top_terms <- award_topics %>% \n",
    "    group_by(topic) %>%\n",
    "# select the 10 terms with the highest beta for each topic\n",
    "    top_n(10, beta) %>% \n",
    "    ungroup() %>% \n",
    "    arrange(topic, -beta)\n",
    "# View the first 2 rows\n",
    "head(award_top_terms,2)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# graph most common words by topic\n",
    "award_top_terms %>% \n",
    "# within each topic, reorder the terms by beta\n",
    "    mutate(term = reorder_within(term, beta, topic)) %>%\n",
    "# make a  bar graph for each of the 7 topics\n",
    "    ggplot(aes(term, beta, fill = factor(topic))) + geom_col(show.legend = FALSE) + \n",
    "    facet_wrap(~topic, scales = 'free') + \n",
    "# flip the axes on the bar graph\n",
    "    coord_flip() +\n",
    "    scale_x_reordered()"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "It appears as though there are some stop words that are data-specific. This intuitively makes sense. For example, the word \"research\" is not generally a stop word, but in the case of grant abstracts, many proposals probably contain \"research\" in them. Other words can also be removed that do not carry any specific \"topic\" meaning, such as \"project\" or \"program\". Based on the background knowledge about the corpus, some of these stop words can be eliminated by creating a secondary list of additional stopwords, and then using another anti-join to remove those as well."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Remove corpus-specific stop words\n",
    "We will remove the corpus-specific stop words abd then repeat the steps above."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# corpus-specific stop words\n",
    "topic_stopwords <- data.frame(word = c('collaborative', 'research', 'project', 'program','students', 'can', 'understanding','new', 'thi'))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "abstract_tokens <- abstracts %>%\n",
    "# split up each abstract into individual words\n",
    "    unnest_tokens(word, abstract) %>% \n",
    "# remove stopwords\n",
    "    anti_join(get_stopwords()) %>% \n",
    "# remove topic spacific stop woords\n",
    "    anti_join(topic_stopwords) %>% \n",
    "# get the stem of the word \n",
    "    mutate(word = wordStem(word)) %>%\n",
    "# aggergate and count all of the words within each unique award\n",
    "    count(unique_award_number, word)\n",
    "head(abstract_tokens)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now that the stop words are removed, the results from the LDA may be different."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# find tf-idf and create document term matrix\n",
    "award_dtm <- abstract_tokens %>% \n",
    "# calculate tf-idf\n",
    "    bind_tf_idf(word, unique_award_number, n) %>% \n",
    "    filter(tf_idf > quantile(tf_idf, .01, na.rm = TRUE)) %>% \n",
    "# convert to a document-term matrix\n",
    "    cast_dtm(unique_award_number, word, n)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# run lda with 7 topics\n",
    "award_lda <- LDA(award_dtm, 7, control=list(seed=0))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# graph most common words per topic\n",
    "award_topics <- tidy(award_lda, matrix = 'beta')\n",
    "award_top_terms <- award_topics %>% group_by(topic) %>% top_n(10, beta) %>% ungroup() %>% arrange(topic, -beta)\n",
    "award_top_terms %>% mutate(term = reorder_within(term, beta, topic)) %>%\n",
    "ggplot(aes(term, beta, fill = factor(topic))) + geom_col(show.legend = FALSE) + \n",
    "facet_wrap(~topic, scales = 'free') + \n",
    "coord_flip() + \n",
    "scale_x_reordered()"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Typically, at this point, visual inspection can be used to get an idea of the specific topics, using the top words as a rough guide. Sometimes, there may be some topics that seem to have words associated with multiple ideas, or some words that are present in multiple topics. This can be due to the number of topics selected at the beginning. This example uses 7 topics, but the topics may vary drastically by running an LDA model with a different number of topics."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Using Text Analysis Output - Matching Topics to PhD Fields\n",
    "\n",
    "Topic modeling allows for the categorization of topics in the grant abstracts. Based on the topics that were found using the previous LDA model above, it may be useful to determine how the topics are correlated with the PhD field of the students who are working on them. LDA assumes that each document is a mixture of the topics, and assigns a per-document-per-topic probabilities, denoted by $\\gamma$. The most likely topic is used as a simple measure of what that grant proposal is about, and this can then be matched to the PhD field of the students working on that grant. In this way, a set of unique grant-students pairs for each grant topic and student PhD field is created and then visualized using a heat map to discover how the two are related.\n",
    "\n",
    "First, the $\\gamma$ probabilities can be extracted the same way as the $\\beta$ probabilities, except with the argument `matrix='gamma'` instead."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# get gamma probabilities\n",
    "abstract_topics <- tidy(award_lda, matrix = 'gamma')"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The highest probability, thus designating the topic, can be found using the `top_n` function."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# find topic for each abstract\n",
    "document_topics <- abstract_topics %>% \n",
    "    group_by(document) %>% \n",
    "    top_n(1, gamma) "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Next, the SED PhD field data can be read into an R object `fields` to match to the students on the awards. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# bring in sed PhD field data\n",
    "qry <- \"\n",
    "select awards.unique_award_number, sed.phdfield_name \n",
    "from ds_iris_umetrics.dbo.core_employee awards\n",
    "join tr_ncses_2021.dbo.sed_umetrics_xwalk xwalk\n",
    "on awards.emp_number = xwalk.emp_number\n",
    "join ds_nsf_ncses.dbo.nsf_sed sed \n",
    "on xwalk.drf_id = sed.drf_id\n",
    "where sed.phdfy = '2015'\n",
    "\"\n",
    "fields <- dbGetQuery(con, qry)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Now that the PhD fields data from the SED has been read into R, it can be joined with the results of the LDA model, assigning labels to each topic by inspection of the top words. To get counts of how many there are in each combination of topic and PhD field, **topic** and **phdfield_name** can be grouped. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# find counts of abstracts within each topic/PhD field combination\n",
    "topic_fields <- document_topics %>% inner_join(fields, by = c('document' = 'unique_award_number')) %>% select(topic, phdfield_name) %>% \n",
    "#   defining each topic field\n",
    "    mutate(topic = factor(topic, levels = 1:7, labels =  c('physics/mechanics', 'materials', 'education', 'computation','math', 'cell biology', 'climate')), phdfield_name = factor(phdfield_name)) %>% \n",
    "#   grouping by each topic-field name combination\n",
    "    group_by(topic, phdfield_name, .drop = FALSE)%>% \n",
    "    summarize(count = n(), .groups = 'keep') \n",
    "\n",
    "head(topic_fields, 20)\n",
    "dim(topic_fields)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "head(document_topics)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Finally, this combined and grouped data can be piped into `ggplot` to make the heat map. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# plot heatmap\n",
    "ggplot(topic_fields, aes(x = topic, y = phdfield_name,fill = count)) + \n",
    "    geom_tile() + \n",
    "    scale_fill_gradient2() + \n",
    "    theme(axis.text.x = element_text(angle = 90))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Matching to SDR Outcomes"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# bring in sed PhD field data\n",
    "qry <- \"\n",
    "select awards.unique_award_number, sdr.emed -- Get award number + SDR outcome\n",
    "from ds_iris_umetrics.dbo.core_employee awards\n",
    "join tr_ncses_2021.dbo.sed_umetrics_xwalk xwalk -- UMETRICS-SED Crosswalk\n",
    "on awards.emp_number = xwalk.emp_number\n",
    "join ds_nsf_ncses.dbo.sdr_drfid_2019 sdr_xwalk -- SED-SDR Crosswalk\n",
    "on xwalk.drf_id = sdr_xwalk.drf_id\n",
    "join ds_nsf_ncses.dbo.sdr_2019 sdr -- SDR \n",
    "on sdr_xwalk.refid = sdr.refid\n",
    "\"\n",
    "fields <- dbGetQuery(con, qry)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "head(fields)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# find counts of abstracts within each topic/PhD field combination\n",
    "topic_fields <- document_topics %>% inner_join(fields, by = c('document' = 'unique_award_number')) %>% select(topic, emed) %>% \n",
    "    mutate(topic = factor(topic,levels = 1:7, labels =  c('physics/mechanics', 'materials', 'education', 'computation','math', 'cell biology', 'climate')),academia = factor(emed)) %>% \n",
    "    group_by(topic, academia, .drop = FALSE)%>% \n",
    "    summarize(count = n(), .groups = 'keep') \n",
    "\n",
    "head(topic_fields, 20)\n",
    "dim(topic_fields)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# plot heatmap\n",
    "ggplot(topic_fields, aes(x = topic, y = academia, fill = count)) + \n",
    "    geom_tile() + \n",
    "    scale_fill_gradient2() + \n",
    "    theme(axis.text.x = element_text(angle = 90))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# Close the database connection\n",
    "dbDisconnect(con)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## (Optional) Supervised Learning: Document Classification"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Remember that topic modeling is an example of an unsupervised learning: looking to uncover structure in the form of topics, but not necessarily knowing the ground truth of how many topics there are."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Supervised learning with text data is also possible. In supervised learning, there is a _known_ outcome or label (_Y_) which is produced given some data (_X_), and in general, the goal is to produce this _Y_ when it is unknown or when _only_ _X_ is provided."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "In order to produce labels, the algorithm needs examples that it can learn from, a \"training set\". In the context of text analysis, developing a training set can be very expensive, as it can require a large amount of human labor or linguistic expertise. **Document classification** is an example of supervised learning in which documents are characterized based on their contents (_X_). A common example of document classification is spam e-mail detection. Another example of supervised learning in text analysis is _sentimenet analysis_, where _X_ is the documents and _Y_ is the state of the author. This \"state\" is dependent on the question, and can range from the author being happy or unhappy with a product to the author being politically conservative or liberal. Another example is _part-of-speech tagging_ where _X_ are individual words and _Y_ is the part-of-speech."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "In the context of this course, one useful application is, for example, classifying whether a text belongs to a given field of study (e.g. broad fields of study used in the SDR reporting). In order to create a text classification model, like in the Machine Learning notebooks, there should be a training dataset with text and associated field of study label, which can be used to train a model and predict the label (field of study) of new, unseen, text."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "### Further Resources"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Remember to review the Text Analysis chapter in the Big Data and Social Science textbook (edited by Dr. Julia Lane, Dr. Rayid Ghani, Dr. Frauke Kreuter) - the link to the textbook  is uploaded on the class website.\n",
    "\n",
    "Other R packages for text analysis include:\n",
    "- `qdap`\n",
    "- `tm`\n",
    "- `SentimentAnalysis`"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": []
  }
 ],
 "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.6.3"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 4
}