Background

This is a milestone report for the Data Science Capstone Project. For this project, the objective is to build a predictive text model. To achieve this, a large corpus of text documents is used as the training data. The model’s purpose is to predict subsequent words based on input text. Additionally, the project will include the development of a shiny App as a predictive text product.

The training data for this project is available at: https://d396qusza40orc.cloudfront.net/dsscapstone/dataset/Coursera-SwiftKey.zip.

This dataset comprises data from blogs, news, and Twitter in four different languages: English, German, Russian, and Finnish. For the purpose of this project, we will focus on the English database.

Load Data

First, let’s load the training data.

## Check if the file exists
if (!file.exists("Coursera-SwiftKey.zip")) {
   download.file("https://d396qusza40orc.cloudfront.net/dsscapstone/dataset/Coursera-SwiftKey.zip","Coursera-SwiftKey.zip")
   unzip("Coursera-SwiftKey.zip")
}
## Load the data into R
blog.url <- "./Dataset/final/en_US/en_US.blogs.txt"
news.url <- "./Dataset/final/en_US/en_US.news.txt"
twitter.url <- "./Dataset/final/en_US/en_US.twitter.txt"

blog <- readLines(blog.url, encoding = "UTF-8", skipNul = TRUE)
news <- readLines(news.url, encoding = "UTF-8", skipNul = TRUE)
twitter  <- readLines(twitter.url, encoding = "UTF-8", skipNul = TRUE)

Basic report of summary statistics

After loading the data, a basic report of the summary statistics for the three files is generated.

library(stringi)

summaryTable <- function(blog, news, twitter) {
    stats <- data.frame(source = c("blog", "news", "twitter"),
            arraySizeMB = c(object.size(blog)/1024^2, object.size(news)/1024^2, object.size(twitter)/1024^2),
            fileSizeMB = c(file.info(blog.url)$size/1024^2, file.info(news.url)$size/1024^2, file.info(twitter.url)$size/1024^2),
            lineCount = c(length(blog), length(news), length(twitter)),
            wordCount = c(sum(stri_count_words(blog)), sum(stri_count_words(news)), sum(stri_count_words(twitter))),
            charCount = c(stri_stats_general(blog)[3], stri_stats_general(news)[3], stri_stats_general(twitter)[3])
    )
    print(stats)
}

summaryTable(blog, news, twitter)
##    source arraySizeMB fileSizeMB lineCount wordCount charCount
## 1    blog   255.35453   200.4242    899288  37546806 206824382
## 2    news    19.76917   196.2775     77259   2674561  15639408
## 3 twitter   318.98975   159.3641   2360148  30096690 162096241

From the summary table,

- Blog Dataset: Contains 899,288 lines of text.

- News Dataset: Consists of 77,259 lines of text.

- Twitter Dataset: Has a whopping 2,360,148 lines of text.

Sampling the dataset

Given the large dataset size, we will randomly select 10,000 samples from each of the three datasets without replacement. These three samples will then be combined into a single dataset.

## Take 10,000 random samples from each dataset, without replacement
set.seed(1234)
sample_size <- 10000

blog_sample <- sample(blog, sample_size, replace = FALSE)
news_sample <- sample(news, sample_size, replace = FALSE)
twitter_sample <- sample(twitter, sample_size, replace = FALSE)

## Combine the 3 samples into a single dataset
sampleData <- c(blog_sample, news_sample, twitter_sample)

Clean the data

Next, we will proceed to clean the data. Profanity will be removed too.

The list of profanity is obtained from this website, provided by Carnegie Mellon University, School of Computer Science: https://www.cs.cmu.edu/~biglou/resources/bad-words.txt

## Load the profanity list into R
download.file("https://www.cs.cmu.edu/~biglou/resources/bad-words.txt", "bad-words.txt")
profanity = readLines("bad-words.txt")
library(tm)

## Create a Corpus
buildCorpus <- function(dataSet) {
    docs <- VCorpus(VectorSource(dataSet))
    toSpace <- content_transformer(function(x, pattern) gsub(pattern, " ", x))
    
    ## Remove URL, Twitter handles and email patterns
    docs <- tm_map(docs, toSpace, "(f|ht)tp(s?)://(.*)[.][a-z]+")
    docs <- tm_map(docs, toSpace, "@[^\\s]+")
    docs <- tm_map(docs, toSpace, "\\b[A-Z a-z 0-9._ - ]*[@](.*?)[.]{1,3} \\b")
    
    ## Remove profanity words from the text in the corpus
    docs <- tm_map(docs, removeWords, profanity)
    
    ## Convert all text to lowercase
    docs <- tm_map(docs, tolower)
    
    ## Remove common English stop words from the text in the corpus. 
    docs <- tm_map(docs, removeWords, stopwords("english"))
    
    ## Remove punctuation from the text in the corpus
    docs <- tm_map(docs, removePunctuation)
    
    ## Remove numerical digits from the text in the corpus
    docs <- tm_map(docs, removeNumbers)
    
    ## Strip the extra whitespace
    docs <- tm_map(docs, stripWhitespace)
    
    ## Change to plain text documents
    docs <- tm_map(docs, PlainTextDocument)
    
    return(docs)    
}

## Build corpus
corpus <- buildCorpus(sampleData)
saveRDS(corpus, file = "./Dataset/en_US.corpus.rds")

## Convert corpus into a dataframe
corpusText <- data.frame(text = unlist(sapply(corpus, '[', "content")), stringsAsFactors = FALSE)

Exploratory Data Analysis

After cleaning the data, we can now perform exploratory data analysis. We will analyse what are the most frequent words, tokens and n-grams in the dataset.

Top 10 most frequent words

library(tidytext)
library(RColorBrewer)
library(ggplot2)

## Create a data frame for wordFreq
tdm <- TermDocumentMatrix(corpus)
freq <- sort(rowSums(as.matrix(tdm)), decreasing = TRUE)
wordFreq <- data.frame(word = names(freq), freq = freq)

## Plot bar chart to display the top 10 most frequent words
g <- ggplot (wordFreq[1:10, ], aes(x = reorder(wordFreq[1:10, ]$word, -wordFreq[1:10, ]$fre),
                                   y = wordFreq[1:10, ]$fre))
g <- g + geom_bar( stat = "Identity", fill = I("blue"))
g <- g + geom_text(aes(label = wordFreq[1:10, ]$fre), vjust = -0.20, size = 3)
g <- g + xlab("") 
g <- g + ylab("Word Frequency")
g <- g + theme(plot.title = element_text(size = 14, hjust = 0.5, vjust = 0.5),
               axis.text.x = element_text(hjust = 0.5, vjust = 0.5, angle = 45),
               axis.text.y = element_text(hjust = 0.5, vjust = 0.5))
g <- g + ggtitle("Top 10 Words")
print(g)

Tokenizing and n-gram frequency

## Token for unigram
unigramTokenizer <- function(x) {
    unlist(lapply(ngrams(words(x), 1), paste, collapse = " "), use.names = FALSE)
}

## Token for bigram
bigramTokenizer <- function(x) {
    unlist(lapply(ngrams(words(x), 2), paste, collapse = " "), use.names = FALSE)
}

## Token for trigram
trigramTokenizer <- function(x) {
    unlist(lapply(ngrams(words(x), 3), paste, collapse = " "), use.names = FALSE)
}

Top 15 most frequent Unigrams

## Create a data frame for unigramMatrixFreq
unigramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = unigramTokenizer))

unigramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(unigramMatrix, 0.99))), decreasing = TRUE)
unigramMatrixFreq <- data.frame(word = names(unigramMatrixFreq), freq = unigramMatrixFreq)

## Plot bar chart to display the top 15 most frequent unigrams
g <- ggplot(unigramMatrixFreq[1: 15, ], aes(x = reorder(word, -freq), y = freq))
g <- g + geom_bar(stat = "identity", fill = I("red"))
g <- g + geom_text(aes(label = freq), vjust = -0.20, size = 3)
g <- g + xlab("") 
g <- g + ylab("Frequency")
g <- g + theme(plot.title = element_text(size = 14, hjust = 0.5, vjust = 0.5),
               axis.text.x = element_text(hjust = 1.0, angle = 45),
               axis.text.y = element_text(hjust = 0.5, vjust = 0.5))
g <- g + ggtitle("Top 15 most frequent Unigrams")
print(g)

Top 15 most frequent Bigrams

## Create a data frame for bigramMatrixFreq
bigramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = bigramTokenizer))

bigramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(bigramMatrix, 0.999))), decreasing = TRUE)
bigramMatrixFreq <- data.frame(word = names(bigramMatrixFreq), freq = bigramMatrixFreq)

## Plot bar chart to display the top 15 most frequent bigrams
g <- ggplot(bigramMatrixFreq[1: 15, ], aes(x = reorder(word, -freq), y = freq))
g <- g + geom_bar(stat = "identity", fill = I("red"))
g <- g + geom_text(aes(label = freq), vjust = -0.20, size = 3)
g <- g + xlab("") 
g <- g + ylab("Frequency")
g <- g + theme(plot.title = element_text(size = 14, hjust = 0.5, vjust = 0.5),
               axis.text.x = element_text(hjust = 1.0, angle = 45),
               axis.text.y = element_text(hjust = 0.5, vjust = 0.5))
g <- g + ggtitle("Top 15 most frequent Bigrams")
print(g)

Top 15 most frequent Trigrams

## Create a data frame for trigramMatrixFreq
trigramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = trigramTokenizer))

trigramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(trigramMatrix, 0.9999))), decreasing = TRUE)
trigramMatrixFreq <- data.frame(word = names(trigramMatrixFreq), freq = trigramMatrixFreq)

## Plot bar chart to display the top 15 most frequent trigrams
g <- ggplot(trigramMatrixFreq[1: 15, ], aes(x = reorder(word, -freq), y = freq))
g <- g + geom_bar(stat = "identity", fill = I("red"))
g <- g + geom_text(aes(label = freq), vjust = -0.20, size = 3)
g <- g + xlab("") 
g <- g + ylab("Frequency")
g <- g + theme(plot.title = element_text(size = 14, hjust = 0.5, vjust = 0.5),
               axis.text.x = element_text(hjust = 1.0, angle = 45),
               axis.text.y = element_text(hjust = 0.5, vjust = 0.5))
g <- g + ggtitle("Top 15 most frequent Trigrams")
print(g)

Next Steps

The insights obtained from the exploratory analysis thus far will prove valuable in the subsequent phase of this project. During this phase, we will develop and create a prediction algorithm as well as a Shiny App.