This report is for the Coursera Data Science Specialization’s Capstone Week 2 Milestone Report. The Capstone project is designed to guide students through a natural language processing (NLP) prediction. Week 2 is part of the preparation for the NLP, with data processing and exploration being the focus. The report is to be graded through four criteria as follows:
The data will be English text from various blogs, news sources, and Twitter. A sample of them will be combined to create a corpus. NLP requires a high amount of computing resources (processor, RAM, GPU, etc.) so the sample may only be a small percentage of the full data. The trade off is the larger the sample, the more accurate your prediction could be.
In this section, any packages are loaded and the global workspace is prepared for all of the work it is about to do.
library(knitr)
library(ggplot2)
library(gridExtra)
library(stringi)
library(kableExtra)
library(parallel)
library(tm)
library(wordcloud)
library(RColorBrewer)
library(foreach)
library(doParallel)
library(RWeka)
rm(list = ls(all.names = TRUE))
The data comes from https://d396qusza40orc.cloudfront.net/dsscapstone/dataset/Coursera-SwiftKey.zip and I have already downloaded the data and unzipped it into my workspace. We will only be using the files in the “en_US” folder.
# English Blogs
blogsFile <- "en_US/en_US.blogs.txt"
con <- file(blogsFile, open = "r")
blogs <- readLines(con, encoding = "UTF-8", skipNul = TRUE)
close(con)
# English News
newsFile <- "en_US/en_US.news.txt"
con <- file(newsFile, open = "r")
news <- readLines(con, encoding = "UTF-8", skipNul = TRUE)
## Warning in readLines(con, encoding = "UTF-8", skipNul = TRUE): incomplete final
## line found on 'en_US/en_US.news.txt'
close(con)
# English Twitter
twitterFile <- "en_US/en_US.twitter.txt"
con <- file(twitterFile, open = "r")
twitter <- readLines(con, encoding = "UTF-8", skipNul = TRUE)
close(con)
rm(con)
A general understanding of the data will be required. To start, a table will be created to show each file’s size, the number of lines, the number of characters, the number of words, and the minimum and mean words per line in each file.
| File | FileSize | Lines | Characters | Words | WPL.Min | WPL.Mean | WPL.Max |
|---|---|---|---|---|---|---|---|
| Blogs | 200 MB | 899288 | 206824505 | 37570839 | 0 | 42 | 6726 |
| News | 196 MB | 766277 | 154209747 | 26173479 | 1 | 34 | 1796 |
| 159 MB | 2360148 | 162096241 | 30451170 | 1 | 13 | 47 |
The source code for the above table is attached as A.1 Text File Summary in the Appendix section.
The summary shows there are differences between the three modes. Twitter has the fewest words per line, but that is part of its 280 character limit design per tweet. News articles are longer than Twitter posts, and blogs have the most words per article. Blogs lend themselves to be more open-ended and allowing analysis of both fact and opinion. The plots below are a good visualization of the table.
## Warning in rm(plot1, plot2, plot3, wp1): object 'wp1' not found
The source code for the above plot is attached as A.2 Histogram of Words per Line in the Appendix section.
To prepare the sample, the three data sets are combined and then sampled at 10%. You can adjust the sample size and I would recommend starting at .005 and stepping it up by .005 if you wanted to perform this evaluation on your computer. The total amount of lines in this sample will be 402,571 with 9,385,107 words.
The source code for preparing the data is attached as A.3 Sample and Clean the Data
The corpus is basically the dictionary of the data. Every word used is included, minus stopwords such as pronouns, prepositions, and other frequently used small words. The corpus also keeps track of the locations of each word in a matrix-style format of dimensions Sample Size Length by Maximum Word Length of a line. To build the corpus, a widely used ‘buildCorpus’ function is created and used to transform the sample in the following ways:
The corpus will then be written to disk in two formats: a serialized R object in RDS format and as a text file. Each will be saved to your working directory and can be used for further evaluation or viewing in your favorite readers.
## Warning in readLines(con, encoding = "UTF-8", skipNul = TRUE): incomplete final
## line found on 'bad_words_list.txt'
| people love drama |
| descendants pfeiffer jonny lee miller chloe grace moretz gulliver mcgrath living cluttered ruins collinwood vast mansion angelique now dominates fishing industry made collins clans fortune tragedy visited family regular basis little david mcgrath lost mother requires live shrink helena bonham carter also pillpopping drunk finally family hire governess bella heathcote spitting image josette longlost love barnabas |
| ah splendid calls sexy party |
| met yet |
| may today bring special day peace love joy one jim aplin abeachdude orlando |
| home almost minutes now |
| icelandic musicians inherent disadvantage among western pop performers isolation high cost living small population need generate sales gold record native son rn elas gumundsson aka mugison illustrates country yield one benefit aspiring artists really awesome locations pressphoto shoots promo pics see mugison variously riding horses mountainous terrain casually laying ice caps canoeing rocky waterways dressed fish trapper boring brickwall backgrounds guy |
| although countries content courses different sna allowed us make comparisons using objective statistical methods found instructional approach clear effect interactions addition noted instructional circumstances multistar pattern interaction created undocumented sna pattern also observed sna can useful studying online course interactions leading enhanced learning |
| happened |
| room perfect temperature right now |
The source code for preparing the corpus is attached as A.4 Build Corpus in the Appendix section.
N-Grams are continuous sequences of ‘n’ items. For this model, N-Grams will be using words to predict the next word(s) using a Shiny application. The model will utilize unigrams, bigrams, trigrams, and fourgrams. Each type of N-Gram will be created. To start, a function to create the N-Gram tokens will be utilized.
## Warning: Removed 2 rows containing missing values (position_stack).
## Warning: Removed 2 rows containing missing values (geom_text).
The source code for this section is attached as A.5 N-Gram Generation in the Appendix section.
I hope this document provides a clear understanding of the news, blogs, and twitter data compiled. This will lay a solid foundation for the future NLP predictive model which will be deployed via Shiny.
The Shiny app proposed will allow a user to type in a word, and the model will predict the next words, up to 3 words. The model will first evaluate any tetragrams for any available prediction, then cycle through trigrams, bigrams, and unigrams.
Basic summary of the three text corpora.
# Calculate the file size
fileSizeMB <- round(file.info(c(blogsFile,
newsFile,
twitterFile))$size / 1024 ^ 2)
# Calculate number of lines per file
numLines <- sapply(list(blogs, news, twitter), length)
# Calculate number of characters per file
numChars <- sapply(list(nchar(blogs), nchar(news), nchar(twitter)), sum)
# Calculate number of words per file (using 4 characters per word)
numWords <- sapply(list(blogs, news, twitter), stri_stats_latex)[4,]
# Calculate the number of words per line
wpl <- mclapply(list(blogs, news, twitter), function(x) stri_count_words(x))
# Create a summary of the words per line, to include the minimum, mean, and maximum
wplSummary = sapply(list(blogs, news, twitter),
function(x) summary(stri_count_words(x))[c('Min.', 'Mean',
'Max.')])
rownames(wplSummary) = c('WPL.Min', 'WPL.Mean', 'WPL.Max')
# Create the summary table
summary <- data.frame(
File = c("Blogs", "News", "Twitter"),
FileSize = paste(fileSizeMB, " MB"),
Lines = numLines,
Characters = numChars,
Words = numWords,
t(rbind(round(wplSummary)))
)
# Display the summary table using Kable
kable(summary,
row.names = FALSE,
align = c("l", rep("r", 7)),
caption = "") %>% kable_styling(position = "left")
# Remove unneeded variables
rm(blogsFile, newsFile, twitterFile, fileSizeMB, numLines, numChars, numWords, wplSummary)
Histogram of words per line for the three text corpora.
plot1 <- qplot(wpl[[1]],
geom = "histogram",
main = "US Blogs",
xlab = "Words per Line",
ylab = "Frequency",
binwidth = 5)
plot2 <- qplot(wpl[[2]],
geom = "histogram",
main = "US News",
xlab = "Words per Line",
ylab = "Frequency",
binwidth = 5)
plot3 <- qplot(wpl[[3]],
geom = "histogram",
main = "US Twitter",
xlab = "Words per Line",
ylab = "Frequency",
binwidth = 1)
plotList = list(plot1, plot2, plot3)
do.call(grid.arrange, c(plotList, list(ncol = 1)))
# free up some memory
rm(plot1, plot2, plot3, wp1)
# Assign the sample size. The larger the number will slow down processing but increase future prediction. I recommend starting with .005 and step up by .005 increments until you reach a point where processing time is too long.
sampleSize = 0.1
# set seed for reproduceable results
set.seed(20201224)
# Combine all three data files into one file and create the sample
allData <- c(blogs, news, twitter)
sampleData <- sample(allData, length(allData) * sampleSize, replace = FALSE)
# Removes all non-English characters from the sample
sampleData <- iconv(sampleData, "latin1", "ASCII", sub = "")
# Write the file to disk, in case you want to use it later
sampleDataFile <- "en_US/en_US.sample.txt"
con <- file(sampleDataFile, open = "w")
writeLines(sampleData, con)
close(con)
# Grab number of lines and words from the sample data
sampleDataLines <- length(sampleData);
sampleDataWords <- sum(stri_count_words(sampleData))
# remove variables no longer needed to free up memory
rm(blogs, news, twitter, allData, sampleDataFile, con)
# Create the function which builds the corpus. This can be used for other NLP analysis and is widely used.
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 profane words from the sample data set. Uses a list stored in the working directory.
con <- file("bad_words_list.txt", open = "r")
profanity <- readLines(con, encoding = "UTF-8", skipNul = TRUE)
close(con)
profanity <- iconv(profanity, "latin1", "ASCII", sub = "")
docs <- tm_map(docs, removeWords, profanity)
# final transformations. Removes stopwords, punctuation, numbers, and converts all characters to lowercase.
docs <- tm_map(docs, tolower)
docs <- tm_map(docs, removeWords, stopwords("english"))
docs <- tm_map(docs, removePunctuation)
docs <- tm_map(docs, removeNumbers)
docs <- tm_map(docs, stripWhitespace)
docs <- tm_map(docs, PlainTextDocument)
return(docs)
}
# build the corpus and write to disk (RDS)
corpus <- buildCorpus(sampleData)
saveRDS(corpus, file = "en_US/en_US.corpus.rds")
# convert corpus to a dataframe and write lines/words to disk (text)
corpusText <- data.frame(text = unlist(sapply(corpus, '[', "content")), stringsAsFactors = FALSE)
con <- file("en_US/en_US.corpus.txt", open = "w")
writeLines(corpusText$text, con)
close(con)
# Show the first 10 documents of the corpus
kable(head(corpusText$text, 10),
row.names = FALSE,
col.names = NULL,
align = c("l"),
caption = "First 10 Documents") %>% kable_styling(position = "left")
# remove variables no longer needed to free up memory
rm(sampleData)
Tokenize Functions
unigramTokenizer <- function(x) NGramTokenizer(x, Weka_control(min = 1, max = 1))
bigramTokenizer <- function(x) NGramTokenizer(x, Weka_control(min = 2, max = 2))
trigramTokenizer <- function(x) NGramTokenizer(x, Weka_control(min = 3, max = 3))
tetragramTokenizer <- function(x) NGramTokenizer(x, Weka_control(min = 4, max = 4))
Unigrams
# Create the Unigram TDM
unigramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = unigramTokenizer))
# eliminate sparse terms for each n-gram and get frequencies of most common n-grams
unigramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(unigramMatrix, 0.999))), decreasing = TRUE)
unigramMatrixFreq <- data.frame(word = names(unigramMatrixFreq), freq = unigramMatrixFreq)
# Generate Unigram plot, which should look similar to the prior word frequency plot
g1 <- ggplot(unigramMatrixFreq[1:15,], aes(x = reorder(word, -freq), y = freq,
fill = word)) +
geom_bar(stat = "identity") +
geom_text(aes(label = freq ), vjust = -0.20, size = 3) +
xlab("") + ylab("Frequency") +
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),
legend.position = "none") +
ggtitle("15 Most Common Unigrams")
print(g1)
Bigrams
# Create the Bigram TDM
bigramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = bigramTokenizer))
# eliminate sparse terms for each n-gram and get frequencies of most common n-grams
bigramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(bigramMatrix, 0.9999))), decreasing = TRUE)
bigramMatrixFreq <- data.frame(word = names(bigramMatrixFreq), freq = bigramMatrixFreq)
# Generate Bigram Plot
g2 <- ggplot(bigramMatrixFreq[1:15,], aes(x = reorder(word, -freq), y = freq,
fill = word)) +
geom_bar(stat = "identity") +
geom_text(aes(label = freq ), vjust = -0.20, size = 3) +
xlab("") + ylab("Frequency") +
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),
legend.position = "none") +
ggtitle("15 Most Common Bigrams")
print(g2)
Trigrams
# Create Trigram TDM
trigramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = trigramTokenizer))
# eliminate sparse terms for each n-gram and get frequencies of most common n-grams
trigramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(trigramMatrix, 0.9999))), decreasing = TRUE)
trigramMatrixFreq <- data.frame(word = names(trigramMatrixFreq), freq = trigramMatrixFreq)
# Generate Trigram Plot
g3 <- ggplot(trigramMatrixFreq[1:15,], aes(x = reorder(word, -freq), y = freq,
fill = word)) +
geom_bar(stat = "identity") +
geom_text(aes(label = freq ), vjust = -0.20, size = 3) +
xlab("") + ylab("Frequency") +
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),
legend.position = "none") +
ggtitle("15 Most Common Trigrams")
print(g3)
# construct word cloud
suppressWarnings (
wordcloud(words = trigramMatrixFreq$word,
freq = trigramMatrixFreq$freq,
min.freq = 1,
max.words = 50,
random.order = FALSE,
rot.per = 0.35,
colors=brewer.pal(8, "YlOrRd"))
)
Tetragrams
# Create Tetragram TDM
tetragramMatrix <- TermDocumentMatrix(corpus, control = list(tokenize = tetragramTokenizer))
# eliminate sparse terms for each n-gram and get frequencies of most common n-grams
tetragramMatrixFreq <- sort(rowSums(as.matrix(removeSparseTerms(tetragramMatrix, 0.99995))), decreasing = TRUE)
tetragramMatrixFreq <- data.frame(word = names(tetragramMatrixFreq), freq = tetragramMatrixFreq)
# generate plot
g4 <- ggplot(tetragramMatrixFreq[1:15,], aes(x = reorder(word, -freq), y = freq,
fill = word)) +
geom_bar(stat = "identity") +
geom_text(aes(label = freq ), vjust = -0.20, size = 3) +
xlab("") + ylab("Frequency") +
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),
legend.position = "none") +
ggtitle("15 Most Common Tetragrams")
print(g4)