Executive Summary

We will be training a predictive text model out of collected blogs, news, and tweets in the English (US) language. In this milestone, we will be discussing the following:

  1. Setting Up and Cleaning Data
  2. Exploratory Data Analysis Per Text Type
  3. Sampling the Data
  4. Corpus Creation, Filtering, and Tokenization
  5. n-gram Frequencies

I’ll also be discussing future plans for the predictive text model and its Shiny app.

Setting Up and Cleaning Data

We first download and unzip the .txt files upon which we will be training the models.

file_url <- "https://example.com"
zip_destination <- "my_data.zip"
download.file(url = "https://d396qusza40orc.cloudfront.net/dsscapstone/dataset/Coursera-SwiftKey.zip", destfile = "my_data.zip", mode = "wb")
unzip(zipfile =  "my_data.zip", exdir = "./")

file_url <- "https://raw.githubusercontent.com/LDNOOBW/List-of-Dirty-Naughty-Obscene-and-Otherwise-Bad-Words/refs/heads/master/en"
download.file(url = file_url, destfile = "./final/en_US/profanity.txt")

We then install the needed packages for natural language processing (NLP).

library(NLP)
library(tm)
library(tokenizers)
library(quanteda)
library(tidyverse)
library(gridExtra)

We now read the text data of the .txt files.

blog_data <- readLines("./final/en_US/en_US.blogs.txt", encoding = "UTF-8")
news_data <- readLines("./final/en_US/en_US.news.txt", encoding = "UTF-8")
twt_data <- readLines("./final/en_US/en_US.twitter.txt", encoding = "UTF-8")

Exploratory Data Analysis Per Text Type

Before moving on to creating a model, let us first create an initial data visualization of the three text types.

blog_words <- str_count(blog_data, "\\w+")
news_words <- str_count(news_data, "\\w+")
twt_words  <- str_count(twt_data, "\\w+")

word_counts_list <- list(blog_words, news_words, twt_words)

# General Summary
data.frame(
  Data = c("Blogs", "News", "Tweets"),
  `No. of Lines` = sapply(word_counts_list, length),
  `No. of Characters` = sapply(list(blog_data, news_data, twt_data), function(x) sum(nchar(x))),
  `No. of Words` = sapply(word_counts_list, sum),
  check.names = FALSE
)
##     Data No. of Lines No. of Characters No. of Words
## 1  Blogs       899288         206824505     38309620
## 2   News      1010206         203214543     35622913
## 3 Tweets      2360148         162096031     31003501
# Stats Summary
data.frame(
  Data = c("Blogs", "News", "Tweets"),
  `Minimum No. of Words` = sapply(word_counts_list, min),
  `Maximum No. of Words` = sapply(word_counts_list, max),
  `Average No. of Words` = sapply(word_counts_list, mean),
  check.names = FALSE
)
##     Data Minimum No. of Words Maximum No. of Words Average No. of Words
## 1  Blogs                    1                 6851             42.59995
## 2   News                    1                 1928             35.26302
## 3 Tweets                    1                   47             13.13625

This shows us that blogs have the highest number of words (and characters) and tweets have the least, which is to be expected granted the standard word requirements for the three text types. However, tweets have the highest number of lines.

Let us now create histograms for the words per line for each .txt file.

# Blog
blog_plot <- qplot(
  blog_words,
  geom = "histogram",
  main = "Histogram of Words per Line for Blog Data",
  xlab = "Words per Line",
  ylab = "Frequency",
  binwidth = 5,
  xlim = c(0, 7000)
)

# News
news_plot <- qplot(
  news_words,
  geom = "histogram",
  main = "Histogram of Words per Line for News Data",
  xlab = "Words per Line",
  ylab = "Frequency",
  binwidth = 5,
  xlim = c(0, 2000)
)

# Tweets
twt_plot <- qplot(
  blog_words,
  geom = "histogram",
  main = "Histogram of Words per Line for Tweet Data",
  xlab = "Words per Line",
  ylab = "Frequency",
  binwidth = 1,
  xlim = c(0, 50)
)

plot_list <- list(blog_plot, news_plot, twt_plot)
do.call(grid.arrange, c(plot_list, list(ncol = 1)))

From the histogram, we can observe that the distribution leans towards having a fewer number of words for all three data types, which aligns with people’s love for brevity in communication.

Sampling the Data

Basing our model on the full text data would be too large. We can create a sample using 0.001 of the existing data, setting a seed for reproducibility.

set.seed(67)

blog_data <- sample(blog_data, length(blog_data) * 0.001)
news_data <- sample(news_data, length(news_data) * 0.001)
twt_data <- sample(twt_data, length(twt_data) * 0.001)

We then clean up the data and combine the samples. We also remove variables to free up memory.

blog_data <- iconv(blog_data, to = "ASCII//IGNORE")
news_data <- iconv(news_data, to = "ASCII//IGNORE")
twt_data  <- iconv(twt_data, to = "ASCII//IGNORE")

sample <- c(blog_data, news_data, twt_data)
sample_filename <- "./final/en_US/en_US.sample.txt"
con <- file(sample_filename, open = "w")
writeLines(sample, con)
close(con)

length(sample)
## [1] 4269
rm(blog_words, news_words, twt_data, blog_data, news_data, twt_data)

We can now build the corpus out of this sample. We first remove punctuation, symbols, numbers, and URLs as to not affect our n-grams. We then filter for stopwords and profanity, whose presence would affect the creation of n-grams. We made use of a .txt file of various profanities available on Github (see beginning of report). Afterwards, we tokenize unigrams, bigrams, and trigrams. Finally, we create and trim a document-feature matrix for future use for the model.

library(quanteda.textstats)

sample <- sample[!is.na(sample)]
  
# Tokenization
sample_tokens <- tokens(corpus(sample),
                        remove_punct = TRUE,
                        remove_symbols = TRUE,
                        remove_numbers = TRUE,
                        remove_url = TRUE)

# Converting to lowercase
sample_tokens <- tokens_tolower(sample_tokens)

# Loading profanity words
profanity_words <- readLines("./final/en_us/profanity.txt", encoding = "UTF-8")
profanity_words <- iconv(profanity_words, to = "ASCII//IGNORE")
profanity_words <- profanity_words[!is.na(profanity_words)]

# Removing stopwords and profanity before n-grams
words_to_remove <- c(stopwords("en"), "text", profanity_words)
words_to_remove <- words_to_remove[!is.na(words_to_remove)]

sample_tokens <- tokens_remove(sample_tokens, pattern = words_to_remove)

# Unigram, bigram, and trigram tokenization
sample_tokens <- tokens_ngrams(sample_tokens, n = 1:3, concatenator = " ")

# DFM creation and trimming
sample_dfm <- dfm(sample_tokens)
sample_dfm <- dfm_trim(sample_dfm, min_docfreq = 2)
all_freq <- textstat_frequency(sample_dfm)

# Count spaces to identify n-gram length
word_count <- stringr::str_count(all_freq$feature, " ") + 1

Finally, we can now display the top 20 most frequent unigrams, bigrams, and trigrams!

top_unigrams <- head(all_freq[word_count == 1, c("feature", "frequency")], 20)
top_bigrams <- head(all_freq[word_count == 2, c("feature", "frequency")], 20) 
top_trigrams <- head(all_freq[word_count == 3, c("feature", "frequency")], 20)

ggplot(top_unigrams, aes(x = reorder(feature, frequency), y = frequency)) +
  geom_col(fill = "blue", color = "white", alpha = 1) +
  coord_flip() +
  labs(
    title = "Top 20 Most Frequent Unigrams",
    x = NULL, 
    y = "Frequency"
  )

ggplot(top_bigrams, aes(x = reorder(feature, frequency), y = frequency)) +
  geom_col(fill = "red", color = "white", alpha = 1) +
  coord_flip() +
  labs(
    title = "Top 20 Most Frequent Bigrams",
    x = NULL, 
    y = "Frequency"
  )

ggplot(top_trigrams, aes(x = reorder(feature, frequency), y = frequency)) +
  geom_col(fill = "orange", color = "white", alpha = 1) +
  coord_flip() +
  labs(
    title = "Top 20 Most Frequent Trigrams",
    x = NULL, 
    y = "Frequency"
  )

Moving Forward

From here, we will then be creating a predictive text model through the use of our n-grams. Our exploratory data analysis may be of use in the creation of an effective model. Bigrams and trigrams may be effective in predicting what word is most likely to follow as they already present common word combinations, which will help in building from the inputted phrase.

The Shiny app shall be simple in nature, but I hope to try to explore laying out a UI using Shiny more to improve front-end skills for R.