lesson4-text-mining.ipynb

{
 "cells": [
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "# Lesson 4 // Text mining"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "---\n",
    "This notebook is the first of three notebooks on the analysis of text data, or text mining. Over the three notebooks we'll look at a selection of methods for examining text data, manipulating it into different forms, and extracting insight from it. We will mainly be using the **tidytext** package in R, which in the words of the authors of the package was developed\n",
    "\n",
    "> \"... because we were familiar with many methods for data wrangling and visualization, but couldn’t easily apply these same methods to text. We found that using tidy data principles can make many text mining tasks easier, more effective, and consistent with tools already in wide use. Treating text as data frames of individual words allows us to manipulate, summarize, and visualize the characteristics of text easily and integrate natural language processing into effective workflows we were already using.\"\n",
    "\n",
    "This first notebook is mainly about manipulating text data and using fairly simple summaries to extract meaning. In particular in this notebook we will:\n",
    "\n",
    "1. Introduce \"tidy\" data principles and see how to make data tidy with the `gather()` and `spread()` functions from the **tidyr** package.\n",
    "2. See how the **tidytext** package applies tidy data principles to text via the `unnest_tokens()` function.\n",
    "3. Extract summaries from text data and examine if these are changing over time.\n",
    "4. Introduce n-grams and show what the effect is of using different values of \"n\".\n",
    "5. Build a simple text generator (a model that generates text).\n",
    "\n",
    "The material in this workbook is based on:\n",
    "* [Chapter 12](http://r4ds.had.co.nz/tidy-data.html) of R4DS, which covers tidy data and the **tidyr** package.\n",
    "* [Chapter 1](http://tidytextmining.com/tidytext.html) and [Chapter 7](http://tidytextmining.com/twitter.html) of TMR. \n",
    "* Chapter 20 of [Data Science from Scratch](http://shop.oreilly.com/product/0636920033400.do) covers natural language processing, and the text generation section borrows from that chapter.\n",
    "\n",
    "---"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "First load the required packages for this notebook."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "library(tidyverse)\n",
    "library(tidytext)\n",
    "library(stringr)\n",
    "library(lubridate)\n",
    "library(wordcloud)\n",
    "\n",
    "options(repr.plot.width=4, repr.plot.height=3) # set plot size in the notebook"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "In this and the following workbooks we'll be using a dataset containing all of Donald Trump's tweets. An up-to-date archive of his tweets is maintained [here](https://github.com/bpb27/trump_tweet_data_archive) (refreshed hourly). These can be downloaded as zipped JSON files. I have stored these tweets (to 18 August 2017) as an .RData file. If you want to update the file, you can download the `condensed_20xx.json.zip` files and use the code below.  "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "```\n",
    "library(jsonlite)\n",
    "\n",
    "tweets <- data.frame()    \n",
    "for(i in 2009:2017){\n",
    "    x <- fromJSON(txt=paste0(\"data/condensed_\",i,\".json\"),simplifyDataFrame = T)\n",
    "    tweets <- rbind.data.frame(tweets, x)\n",
    "}\n",
    "rm(x)\n",
    "    \n",
    "save(tweets,file=\"data/trump-tweets.RData\")    \n",
    "```"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We load the data, which consists of a single data frame called `tweets`, and examine the contents:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "load(\"data/trump-tweets.RData\")\n",
    "str(tweets)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We'll start by turning the data frame into a tibble, and turning the date into a format that will be easier to work with later on. We use the `parse_datetime()` function from the **lubridate** package. The package is a Hadley Wickham one but not part of the core tidyverse. We probably won't have time to look into processing dates and times in this course, but if you are interested the relevant chapter of R4DS is [here](.http://r4ds.had.co.nz/dates-and-times.html)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# turn into a tibble\n",
    "tweets <- as.tibble(tweets)\n",
    "# parse the date\n",
    "tweets <- tweets %>% mutate(date = parse_datetime(str_sub(tweets$created_at,5,30), \"%b %d %H:%M:%S %z %Y\"))\n",
    "tweets$date[1]"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Once the dates and times have been appropriately parsed we can perform various operations on them. For example, below we work out the earlier and latest tweets in the dataset, and the duration of time covered by the dataset."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "min(tweets$date)\n",
    "max(tweets$date)\n",
    "max(tweets$date) - min(tweets$date)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Let's look at a few tweets:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "set.seed(2)\n",
    "sample_tweets <- tweets %>% sample_n(5) %>% select(date,text)\n",
    "sample_tweets"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We start by plotting the number of tweets Trump has made over time. Retweets are shown in blue."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "ggplot(tweets, aes(x = date, fill = is_retweet)) +\n",
    "  geom_histogram(position = \"identity\", bins = 101, show.legend = FALSE)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "You'll see from the few example tweets above that tweets have a particular format, but that that format is quite hard to pin down. There are special characters like `@` and `#` that mean something, some tweets have links while others do not, some are a single sentence and others are several, some mention people by name, and so on. How are we going to structure this data in a meaningful way?\n",
    "\n",
    "To answer this question, we're going to go back a bit and talk about \"tidy\" data. "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Tidy data\n",
    "\n",
    "Tidy data is basically just a way of consistently organizing your data that often makes subsequent analysis easier, particularly if you are using **tidyverse** packages. Tidy data has three requirements:\n",
    "\n",
    "* Each variable has its own column.\n",
    "* Each observation has its own row.\n",
    "* Each value has its own cell.\n",
    "\n",
    "This only really makes sense once you work out what the variables and observations are. Of course you can't define a variable as \"what's in a column\", or all data will be tidy! For example, suppose we have the following data frame, containing movie ratings for 3 users and 4 movies:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "untidy_ratings <- tribble(\n",
    "  ~user_id, ~age, ~city, ~movie1, ~movie2, ~movie3,\n",
    "  1, 49, \"Cpt\", 5, NA, NA,\n",
    "  2, 20, \"Cpt\", 3, 3, 1, \n",
    "  3, 30, \"Jhb\", NA, 5, 1\n",
    ")\n",
    "untidy_ratings "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "This data frame is not tidy because movie ratings are spread across multiple columns. \n",
    "\n",
    "The \"tidy\" way to think about this data is that the variables are the `user_id`, the user's demographic variables (`age`, `city`), the `title` of the movie, and the `rating` given. At the moment some column names (`movie1`, `movie2`, `movie3`) are actually *values* of the variable. This is a common problem with untidy data. The observations in this case are user-movie combinations.\n",
    "\n",
    "Note that this isn't to say that \"untidy\" data is never useful - in fact, we used data in just the format above when building recommender systems. But there are advantages to working with tidy data, especially if you are using packages from the tidyverse.\n",
    "\n",
    "To make the data frame tidy, we use the `gather()` function from the **tidyr** package, which provides a number of functions for getting data into (and out of) tidy format."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_ratings <- untidy_ratings %>% gather(movie1,movie2,movie3, key = \"title\", value = \"rating\")\n",
    "tidy_ratings"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "This data frame shows all user-movie combinations. Those observations with no rating (because the user has not seen the movie) are given an `NA`. We say that missing values are *explicitly* represented. Another way of representing missing values is to omit the corresponding observation from the data frame. This is an *implicit* representation of a missing value. To use the implicit representation we just set `na.rm = TRUE` when using `gather()`."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_ratings_imp <- untidy_ratings %>% gather(movie1,movie2,movie3, key = \"title\", value = \"rating\", na.rm = TRUE)\n",
    "tidy_ratings_imp"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We can move back to an explicit representation of missing values using the `complete()` function. Note that we have to tell the `complete()` function that `age` and `city` do not vary over individual, and we do this using the `nesting()` command (because age and city are \"nested within\" user). "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_ratings_imp %>% complete(nesting(user_id, age, city), title)\n",
    "\n",
    "# try these:\n",
    "# tidy_ratings_imp %>% complete(c(user_id, age, city), title)  # crossed, not nested, will look for all combos\n",
    "# tidy_ratings_imp %>% complete(user_id, title) # will treat like rating i.e. will have NAs"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We can move in the opposite direction (spreading a variable across multiple columns) using the `spread()` function."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "untidy_ratings <- tidy_ratings %>% spread(key = \"title\", value = \"rating\")\n",
    "untidy_ratings"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Note that its not always the case that a \"long\" data format is tidy and a \"wide\" format is not. For example, the data frame below is tidy. \n",
    "```\n",
    "# A tibble: 6 x 4\n",
    "   town month avgtemp rainfall\n",
    "  <chr> <chr>   <dbl>    <dbl>\n",
    "1     A   Jan      24       12\n",
    "2     B   Jan      27       10\n",
    "3     C   Jan      30       16\n",
    "4     A   Jun      14       22\n",
    "5     B   Jun      20       62\n",
    "6     C   Jun       5       16\n",
    "```\n",
    "but it would not be tidy if we reshape the data into a \"longer\" format:\n",
    "```\n",
    "# A tibble: 12 x 4\n",
    "    town month  weather    value\n",
    "   <chr> <chr>    <chr>    <dbl>\n",
    " 1     A   Jan  avgtemp       24\n",
    " 2     B   Jan  avgtemp       27\n",
    " 3     C   Jan  avgtemp       30\n",
    " 4     A   Jun  avgtemp       14\n",
    " 5     B   Jun  avgtemp       20\n",
    " 6     C   Jun  avgtemp        5\n",
    " 7     A   Jan rainfall       32\n",
    " 8     B   Jan rainfall       30\n",
    " 9     C   Jan rainfall       36\n",
    "10     A   Jun rainfall       22\n",
    "11     B   Jun rainfall       22\n",
    "12     C   Jun rainfall       16\n",
    "```\n",
    "There are several more examples in [Chapter 12](http://r4ds.had.co.nz/tidy-data.html) of R4DS, which covers tidy data and the **tidyr** package."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Tidy text data\n",
    "\n",
    "Tidy text is defined by the authors of **tidytext** as \"a table with one-token-per-row\" (see [Chapter 1](http://tidytextmining.com/tidytext.html) of TMR). A *token* is a whatever unit of text is meaningful for your analysis: it could be a word, a word pair, a sentence, a paragraph, a chapter, whatever. \n",
    "\n",
    "That means that the process of getting text data tidy is largely a matter of \n",
    "\n",
    "1. Deciding what the level of the analysis is going to be - what the \"token\" is.\n",
    "2. Splitting the text into tokens, a process called *tokenization*.\n",
    "\n",
    "We're now going to look in more detail at tokenization."
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Tokenization with `unnest_tokens()`\n",
    "\n",
    "Tokenization is the process of splitting text up into the units that we are interested in analyzing. The `unnest_tokens()` function performs tokenization by splitting text up into the required tokens, and creating a new data frame with one token per row i.e. tidy text data.\n",
    "\n",
    "Suppose we want to analyze the individual words Trump uses in his tweets. We do this by `unnest_tokens(tweets, word, text, token = \"words\")`. Note the arguments passed to `unnest_tokens()`:\n",
    "\n",
    "* the \"messy\" data frame containing the text (`tweets`)\n",
    "* the variable name we want to use for the tokens in the new tidy data frame (`word`)\n",
    "* the variable name where the text is stored in the \"messy\" data frame (`text` i.e. the tweets are in `tweets$text`)\n",
    "* the unit of tokenization (`token=\"words\"`)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "unnest_tokens(sample_tweets, word, text, token = \"words\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Let's see what happens if we tokenize by sentences:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "unnest_tokens(sample_tweets, sentences, text, token = \"sentences\") "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "A really nice feature of **tidytext** is that you can tokenize by regular expressions. This gives you a lot of flexibility in deciding what you want a token to constitute. For example, for analyzing tweet data we can explicitly include symbols like `@` and `#` that mean something, and exclude symbols like `?` and `!` that don't add anything (unless we want to include them, in which case we can!)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "unnest_tokens(sample_tweets, word, text, token = \"regex\", pattern = \"[^A-Za-z\\\\d_#@']\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We're now in a position to transform the full set of tweets into tidy text format. We'll tokenize with the regular expression we used in the last example above. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "unnest_reg <- \"[^A-Za-z\\\\d_#@']\"\n",
    "\n",
    "tidy_tweets <- tweets %>% \n",
    "  unnest_tokens(word, text, token = \"regex\", pattern = unnest_reg) %>%\n",
    "  select(date, word, favorite_count)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Let's plot the most commonly used words:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_tweets %>%\n",
    "  count(word, sort = TRUE) %>%\n",
    "  filter(rank(desc(n)) <= 20) %>%\n",
    "  ggplot(aes(reorder(word,n),n)) + geom_col() + coord_flip() + xlab(\"\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Not very useful! What's happening here, unsurprisingly, is that common words like \"the\", \"to\", etc are coming up most often. We can tell **tidytext** to ignore these words (which are called \"stop words\"). Let's have a look at a sample of stop words contained in the dictionary used by **tidytext**:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "sort(sample(stop_words$word,100))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "There are also some words like \"http\" and \"t\" that are not stop words but that we probably don't want. We need to remove these \"manually\" using `str_replace_all()` with a regular expression of our choice. The regular expression below is a bit more complex that what we've used before. The basic idea is:\n",
    "\n",
    "* `https?:` finds `http:` or `https:`.\n",
    "* `.*` finds the longest match, which we don't want (why?), so we use `.*?`, which finds the *shortest* match.\n",
    "* the remaining part in round brackets `([\\\\s]|[a-zA-Z0-9]$))` says \"go till you hit a space or the end of the string\".\n",
    "* same applies for `www`.\n",
    "* `&amp;`, `&lt;`, `&gt;` sometimes appear in the tweets to indicate `&`, `<`, `>` respectively.\n",
    "* `RT` removes any retweets (we only want to look at Trump's own tweets).\n",
    "\n",
    "We look at a few examples below. Try experiment with the input tweets and the regular expression to get a good idea of what everything does.\n"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# pattern that we want to remove (replace with nothing)\n",
    "replace_reg <- \"(https?:.*?([\\\\s]|[a-zA-Z0-9]$))|(www:.*?([\\\\s]|[a-zA-Z0-9]$))|&amp;|&lt;|&gt;|RT\"\n",
    "\n",
    "# tweet with a link\n",
    "tweets$text[39]\n",
    "str_replace_all(tweets$text[39], replace_reg, \"\")\n",
    "# tweet with a link at end of tweet\n",
    "tweets$text[2]\n",
    "str_replace_all(tweets$text[2], replace_reg, \"\")\n",
    "# tweet with a link and an &amp; \n",
    "tweets$text[15251]\n",
    "str_replace_all(tweets$text[15251], replace_reg, \"\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We now rerun the tokenization with these new options and again plot the most common words in the tweets:"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "unnest_reg <- \"[^A-Za-z_\\\\d#@']\"\n",
    "\n",
    "tidy_tweets <- tweets %>% \n",
    "    filter(!str_detect(text, \"^RT\")) %>% # remove retweets\n",
    "    mutate(text = str_replace_all(text, replace_reg, \"\")) %>% # remove with a reg exp (http, www, etc)\n",
    "    unnest_tokens(word, text, token = \"regex\", pattern = unnest_reg) %>%\n",
    "    filter(!word %in% stop_words$word,str_detect(word, \"[a-z]\")) %>% # remove stop words\n",
    "  select(date,word,favorite_count) "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We again plot the most commonly used tokens in our newly-cleaned data frame."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_tweets %>%\n",
    "  count(word, sort = TRUE) %>%\n",
    "  filter(rank(desc(n)) <= 20) %>%\n",
    "  ggplot(aes(reorder(word,n),n)) + geom_col() + coord_flip() + xlab(\"\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "It turns out Trump likes talking about himself, mostly. \n",
    "\n",
    "We can also see whether being president has changed the most commonly used words he uses. To do this we first create a new variable, a binary indicator of whether a tweet was made before or after Trump became president. We do this by comparing the date of the tweet to the date of the US election (8th November 2016). Note that once we have the date in a recognized format like `ymd` or `dmy`, this comparison can be trivially done."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "tidy_tweets <- tidy_tweets %>% mutate(is_prez = (date > ymd(20161108)))"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "options(repr.plot.width=6, repr.plot.height=5) # make plot size bit bigger for next plots\n",
    "\n",
    "tidy_tweets %>%\n",
    "  group_by(is_prez) %>%\n",
    "  count(word, sort = TRUE) %>%\n",
    "  filter(rank(desc(n)) <= 20) %>%\n",
    "  ggplot(aes(reorder(word,n), n, fill = is_prez)) + geom_col() + coord_flip() + xlab(\"\")"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The plot above is a bit unsatisfying - there are obviously a lot more tweets pre-presidency, and that makes it difficult to see what is happening in the post-presidency frequencies. Below we transform the absolute frequencies into relative ones and plot those (it may be helpful to break up the second code block to understand what each line does)."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "total_tweets <- tidy_tweets %>% \n",
    "                 group_by(is_prez) %>% \n",
    "                 summarise(total = n())"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_tweets %>%\n",
    "  group_by(is_prez) %>% \n",
    "  count(word, sort = TRUE) %>% # count the number of times word used \n",
    "  left_join(total_tweets) %>% # add the total number of tweets made (pre- or post-prez)\n",
    "  mutate(freq = n/total) %>% # add relative frequencies\n",
    "  filter(rank(desc(freq)) < 20) %>%\n",
    "  ggplot(aes(reorder(word,freq),freq,fill=is_prez)) + \n",
    "  geom_col() + \n",
    "  coord_flip() + \n",
    "    xlab(\"\") +\n",
    "  facet_grid(.~is_prez)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Below we show a wordcloud of Trump's tweets after he became president. Wordclouds are not particularly informative - they just plot words proportional to their frequency of use and position them in an attractive way. This uses the **wordcloud** package."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "tidy_tweets %>%\n",
    "    filter(is_prez == TRUE) %>%\n",
    "  count(word) %>%\n",
    "  with(wordcloud(word, n, max.words = 100))"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Unigrams, bigrams, n-grams\n",
    "\n",
    "An *n*-gram is a sequence of *n* words in a text. Unigrams are single words, bigrams are pairs of adjacent words, trigrams are sequences of three words, and so on.\n",
    "\n",
    "The `unnest_tokens()` function allows you to easily extract n-grams using the \"ngrams\" token."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# bigrams\n",
    "unnest_tokens(sample_tweets, bigram, text, token = \"ngrams\", n = 2) %>% head(10)"
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# trigrams\n",
    "unnest_tokens(sample_tweets, bigram, text, token = \"ngrams\", n = 3) %>% head(10)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We extract the full set of bigrams below, and do the same cleaning up we did for unigrams earlier. Removing stop words is a bit trickier with bigrams. We need to separate each bigram into its constituent words, remove the stop words, and then put the bigrams back together again. Both `separate()` and `unite()` are **tidyr** functions."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "replace_reg <- \"(https?:.*?([\\\\s]|[a-zA-Z0-9]$))|(www:.*?([\\\\s]|[a-zA-Z0-9]$))|&amp;|&lt;|&gt;|RT\"\n",
    "\n",
    "# tokenization\n",
    "tweet_bigrams <- tweets %>%\n",
    "  filter(!str_detect(text, \"^RT\")) %>%\n",
    "  mutate(text = str_replace_all(text, replace_reg, \"\")) %>%\n",
    "  unnest_tokens(bigram, text, token = \"ngrams\", n = 2)\n",
    "\n",
    "# separate the bigrams \n",
    "bigrams_separated <- tweet_bigrams %>%\n",
    "  separate(bigram, c(\"word1\", \"word2\"), sep = \" \")\n",
    "\n",
    "# remove stop words\n",
    "bigrams_filtered <- bigrams_separated %>%\n",
    "  filter(!word1 %in% stop_words$word) %>%\n",
    "  filter(!word2 %in% stop_words$word)\n",
    "\n",
    "# join up the bigrams again\n",
    "bigrams_united <- bigrams_filtered %>%\n",
    "  unite(bigram, word1, word2, sep = \" \")\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We can now see what the most common bigrams are. Note that these are very different from the most common words. That is, they definitely provide different and useful information over and above what the unigrams did."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "bigram_counts <- bigrams_filtered %>% \n",
    "  count(word1, word2, sort = TRUE) %>% \n",
    "filter(rank(desc(n)) <= 10)\n",
    "bigram_counts\n",
    "\n",
    "# same answer (not run)\n",
    "# bigrams_united %>% \n",
    "# count(bigram, sort = TRUE) %>% \n",
    "# filter(rank(desc(n)) <= 10)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Text generation\n",
    "\n",
    "One area of natural language processing is (natural language) *generation*, roughly speaking an attempt to generate realistic looking and sounding text and speech from some data or knowledge base. For example, one might automatically generate a short textual weather report from predicted numerical inputs.\n",
    "\n",
    "In this section we'll build a model for generating Trump-like tweets. We do this by looking at sequences of words (or more generally *n*-grams) that Trump uses. Let's start by generating Trump-like *sentences*. We do this by:\n",
    "\n",
    "1. Creating a dictionary of all words Trump has started a sentence with.\n",
    "2. Randomly choosing one of these \"start words\". \n",
    "3. Identify all the instances in which he used that word, and in each case extract the \"word\" that followed it. A \"word\" can be a full stop, indicating the end of the sentence. Some words may appear more than once. Create a list with these \"following words\" and the frequency with which they occur on the list. \n",
    "4. To select the next word in the sentence, we choose a word from the list, either totally randomly or with probability proportional to the frequency with which each word appears on the list. \n",
    "5. Repeat steps 3 and 4 until a full stop is reached.\n",
    "\n",
    "We still need to turn sentences into tweets - a simple way is just to generate sentences until you are out of space (140 characters).\n",
    "\n",
    "In the previous examples full stops were included as separating characters i.e. we split a string wherever we encountered a full stop (see `unnest_reg` above, and compare below). Now we want to treat a full stop as equivalent to a word. We thus need to create a new tidy tweets data frame that does this. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "unnest_reg <- \"[^\\\\.A-Za-z_\\\\d#@']\" # note adding a fullstop to the reg exp used before\n",
    "\n",
    "tidy_tweets_wstop <- tweets %>% \n",
    "  filter(!str_detect(text, \"^RT\")) %>%\n",
    "  mutate(text = str_replace_all(text, \"[Dd]on't\", \"dont\")) %>% # some additional cleaning\n",
    "  mutate(text = str_replace_all(text, \"(j\\\\.)|(J\\\\.)\", \"j\")) %>% # some additional cleaning\n",
    "  mutate(text = str_replace_all(text, replace_reg, \"\")) %>%\n",
    "  mutate(text = str_replace(text, \"\\\\.\", \" \\\\.\")) %>% # add a space before fullstop so counted as own word\n",
    "  unnest_tokens(word, text, token = \"regex\", pattern = unnest_reg) %>%\n",
    "  select(id_str, date, word) %>%\n",
    "  group_by(id_str) %>% # group words by tweet\n",
    "  mutate(next_word = lead(word)) # the \"lead\" and \"lag\" operators can be very useful!"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Let's have a look at the data frame we just constructed."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "head(tidy_tweets_wstop,40)"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We now count the number of times that each word pair (*word* followed by *next_word*) occurs. This is the same as a bigram frequency count we did above, just that we've included full stops."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "transitions <- tidy_tweets_wstop %>%\n",
    "  group_by(word,next_word) %>%\n",
    "  count() %>% \n",
    "  ungroup() # remember to ungroup else later steps are slow!"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The last full stop of every tweet is followed by an `NA`. This causes problems later on, so we replace the `NA` with another full stop."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "transitions$next_word[is.na(transitions$next_word)] <- \".\""
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Finally, we unleash our unigram-based Trump tweeter. This model randomly samples from the list of next words. It continues to create sentences until the tweet is over 140 characters *and* full stop is reached. Thus the tweets it generates will be too long (more than 140 characters). As an exercise, try fixing this problem."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "set.seed(2)\n",
    "# trump v1, unigram model, random sampling\n",
    "\n",
    "# start at the end of a sentence (so next word is a start word)\n",
    "current <- \".\"\n",
    "result <- \".\"\n",
    "keep_going <- TRUE\n",
    "while(keep_going == TRUE){\n",
    "    \n",
    "    # get next word\n",
    "    next_word <- transitions %>% \n",
    "    filter(word == as.character(current)) %>% \n",
    "    sample_n(1) %>% # random sampling\n",
    "    select(next_word)\n",
    "    \n",
    "    # combine with result so far\n",
    "    result <- str_c(result,\" \", next_word)\n",
    "    current <- next_word\n",
    "\n",
    "    # does the current word appear in the 'word' column?\n",
    "    n_current <- sum(transitions$word == as.character(current))\n",
    "  \n",
    "    # keep going if can look up current word and tweet is < 140 or current word is not .\n",
    "    keep_going <- ifelse(n_current == 0, FALSE,\n",
    "                         ifelse(nchar(result) < 140, TRUE, \n",
    "                                ifelse(str_detect(current,\"\\\\.\"), FALSE, TRUE)))\n",
    "    \n",
    "}\n",
    "result"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "The generated tweets have traces of Trump but are more or less gibberish. We can try improve the generation model by changing the sampling to be proportional to the bigram frequency rather than random."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "set.seed(1)\n",
    "# trump v2, unigram model, sample using transition probabilities\n",
    "\n",
    "# start at the end of a sentence (so next word is a start word)\n",
    "current <- \".\"\n",
    "result <- \".\"\n",
    "keep_going <- TRUE\n",
    "while(keep_going == TRUE){\n",
    "  \n",
    "    # get next word\n",
    "    next_word <- transitions %>% \n",
    "    filter(word == as.character(current)) %>% \n",
    "    sample_n(1, weight = n) %>% # proportional to count\n",
    "    select(next_word)\n",
    "  \n",
    "    # combine with result so far\n",
    "    result <- str_c(result,\" \", next_word)\n",
    "    current <- next_word\n",
    "  \n",
    "  # does the current word appear in the 'word' column?\n",
    "  n_current <- sum(transitions$word == as.character(current))\n",
    "  \n",
    "  # keep going if can look up current word and tweet is < 140 or current word is not .\n",
    "  keep_going <- ifelse(n_current == 0, FALSE,\n",
    "                       ifelse(nchar(result) < 140, TRUE, \n",
    "                              ifelse(str_detect(current,\"\\\\.\"), FALSE, TRUE)))\n",
    "  \n",
    "}\n",
    "result"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Its hard to tell, but from a few runs it looks a little bit better but still not great. Let's see if we do any better if we look at transitions between bigrams rather than between words. As for the unigram model, we first need to add full stops, and then count how many times each transition (now between pairs of *bigrams*) occurs."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "# we've already lagged unigrams with full stops before, use these to create lagged bigrams\n",
    "bigrams_wstop <- tidy_tweets_wstop %>% \n",
    "    filter(!is.na(word)) %>% # don't want to unite with NAs\n",
    "    filter(!is.na(next_word)) %>%\n",
    "    unite(bigram, word, next_word, sep = \" \") %>%\n",
    "    mutate(next_bigram = lead(bigram,2)) "
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "We now calculate the frequency count for each *bigram*-to-*next_bigram* transition. We first remove any rows where either *bigram* or *next_bigram* is missing. "
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {
    "collapsed": true
   },
   "outputs": [],
   "source": [
    "# transition matrix\n",
    "bigram_transitions <- bigrams_wstop %>%\n",
    "    filter(!is.na(bigram)) %>% \n",
    "    filter(!is.na(next_bigram)) %>%\n",
    "    group_by(bigram,next_bigram) %>%\n",
    "    count() %>% \n",
    "    ungroup() # remember to ungroup else later steps are slow!"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "In the bigram model, a full stop is one \"word\" in a bigram. So we can't start with *only* a full stop, like we did before. The approach we'll take is to randomly select one of the bigrams Trump has used."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "set.seed(6)\n",
    "\n",
    "# extract all starting rows\n",
    "start_bigrams <- bigrams_wstop %>%\n",
    "    group_by(id_str) %>%\n",
    "    slice(1) %>%    # takes the first row from each tweet\n",
    "    ungroup()\n",
    "\n",
    "# choose one starting bigram\n",
    "current <- start_bigrams %>%\n",
    "  sample_n(1) %>% \n",
    "  select(bigram) %>% \n",
    "  as.character()\n",
    "\n",
    "current"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "Finally we can put everything together to generate a tweet using the bigram model we just created."
   ]
  },
  {
   "cell_type": "code",
   "execution_count": null,
   "metadata": {},
   "outputs": [],
   "source": [
    "# trump v3, bigram model, sample using transition probabilities\n",
    "\n",
    "# start with starting bigram previously generated\n",
    "result <- current\n",
    "keep_going <- TRUE\n",
    "while(keep_going == TRUE){\n",
    "  \n",
    "    # get next word\n",
    "    next_bigram <- bigram_transitions %>% \n",
    "    filter(bigram == as.character(current)) %>% \n",
    "    sample_n(1, weight = n) %>% \n",
    "    select(next_bigram)\n",
    "\n",
    "    # combine with result so far\n",
    "    result <- str_c(result,\" \", next_bigram)\n",
    "    current <- next_bigram\n",
    "  \n",
    "    # does the current bigram appear in the bigram column?\n",
    "    n_current <- sum(bigram_transitions$bigram == as.character(current))\n",
    "  \n",
    "  # keep going if can look up current bigram and tweet is < 140 or current bigram\n",
    "  # does not contain a .\n",
    "  keep_going <- ifelse(n_current == 0, FALSE,\n",
    "                       ifelse(nchar(result) < 140, TRUE, \n",
    "                              ifelse(str_detect(current,\"\\\\.\"), FALSE, TRUE)))\n",
    "}\n",
    "result"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "## Exercises\n"
   ]
  },
  {
   "cell_type": "markdown",
   "metadata": {},
   "source": [
    "1. Read Section 12.1 to 12.4 of [the R4DS chapter](http://r4ds.had.co.nz/tidy-data.html) on tidy data and do the relevant exercises, in particular the ones in the [\"Separating and Uniting\"](http://r4ds.had.co.nz/tidy-data.html#separating-and-uniting) and [\"Spreading and Gathering\"](http://r4ds.had.co.nz/tidy-data.html#spreading-and-gathering) sections.\n",
    "\n",
    "2. In this exercise we'll look at some frequency distributions in the book \"Siddhartha\" by Herman Hesse. We'll download the book from the [Project Gutenberg](https://www.gutenberg.org/) collection. The book we want has the Project Gutenberg ID \"2500\" (or pick another one you want to work with). To find the ID you need, either look on the Project Gutenberg site or, in R, we can make use of the **gutenbergr** package, which helps you download and process public domain books (see vignette [here](https://cran.r-project.org/web/packages/gutenbergr/vignettes/intro.html) for details).\n",
    "```\n",
    "library(gutenbergr)\n",
    "gutenberg_metadata %>% filter(title == \"Siddhartha\")\n",
    "```\n",
    "We can read in the text of the book using **rvest** and convert it to a data frame for use in **tidytext**. The *text* variable contains the downloaded text (the novel *and* some additional information about Project Gutenberg, visit the link http://www.gutenberg.org/cache/epub/2500/pg2500.txt to see what is downloaded.\n",
    "```\n",
    "library(rvest)\n",
    "sidd <- read_html(\"http://www.gutenberg.org/cache/epub/2500/pg2500.txt\")\n",
    "sidd_tidy <- data.frame(id = 1, text = html_text(html_nodes(sidd, css=\"body\")))\n",
    "```\n",
    "Use `unnest_tokens()` to plot a frequency distribution of words used in the novel. Arrange the histogram so that words appear from left to right in order of their frequency of occurence. What do you find? Word frequency distributions often follow the same form, see the section of TMR on [\"Zipf's law\"](http://tidytextmining.com/tfidf.html#zipfs-law) for details. \n",
    "3.  Using the same data as above, and a different call to `unnest_tokens()`, plot the distribution of sentence lengths in *Siddhartha*.\n",
    "4. How might you improve the tweet generator so that the sentences that it generates are not entirely independent  of one another?"
   ]
  }
 ],
 "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.0"
  }
 },
 "nbformat": 4,
 "nbformat_minor": 2
}