Reading in the Raw Data

To get an idea of what we’re working with, I read in each of the three source files. When making the model, I’ll use only the sampled data to reduce memory load.

path_news<-"C:/Users/kwilliams/Documents/coursera/Coursera-SwiftKey/final/en_US/en_US.news.txt"
path_blog<-"C:/Users/kwilliams/Documents/coursera/Coursera-SwiftKey/final/en_US/en_US.blogs.txt"
path_twit<-"C:/Users/kwilliams/Documents/coursera/Coursera-SwiftKey/final/en_US/en_US.twitter.txt"
start_time<-Sys.time()
news<-readr::read_lines(path_news)
blog<-readr::read_lines(path_blog)
twit<-readr::read_lines(path_twit)
Sys.time()-start_time
## Time difference of 17.07478 secs

Below, I make a table of common statistics about the size of the files we’re working with:

library(stringi)
## Warning: package 'stringi' was built under R version 4.3.2
lines<-c(length(news),length(blog),length(twit))
size<-c(file.size(path_news),file.size(path_blog),file.size(path_twit))
char<-c(sum(nchar(news)),sum(nchar(blog)),sum(nchar(twit)))
word<-c(sum(stri_count_words(news)),sum(stri_count_words(blog)),sum(stri_count_words(twit)))
data.frame(file=c("News","Blog","Twitter"), file.size.Mb=size/100000, Lines=lines, Characters=char, Words=word)
##      file file.size.Mb   Lines Characters    Words
## 1    News     2058.119 1010242  203223159 34762658
## 2    Blog     2101.600  899288  206824505 37546806
## 3 Twitter     1671.053 2360148  162096031 30096649

Sampling and Cleaning

Working with, in total, 4,269,678 lines would be impractical in terms of memory usage. Just loading in the whole dataset for line and character analysis took about 15 seconds–that doesn’t sound like a lot, but if every operation on that data took that long, we’d be waiting a long time! We can rely on a 1% random sample of each source to give us a reliable understanding of the data without having to use all of it.

library(LaF)
set.seed(666)
s_news<-sample_lines(filename=path_news, n=lines[1]*0.01,nlines=lines[1])
s_news<-s_news[complete.cases(s_news)]
s_blog<-sample_lines(filename=path_blog, n=lines[2]*0.01,nlines=lines[2])
s_blog<-s_blog[complete.cases(s_blog)]
s_twit<-sample_lines(filename=path_twit, n=lines[3]*0.01,nlines=lines[3])
s_twit<-s_news[complete.cases(s_twit)]

Each line is an element of a vector.

Next, we look at the features of the data. Based on what we know of the data sources, we know the following are going to be a problem for language modeling:

Creating tokens objects and removing stopwords:

library(quanteda)
token_news<-tokens(s_news, remove_punct=TRUE, remove_symbols=TRUE, remove_numbers=TRUE,remove_url=TRUE, split_hyphens=TRUE)
token_news<-tokens_select(token_news, pattern=stopwords("en"), selection="remove")

token_blog<-tokens(s_blog, remove_punct=TRUE, remove_symbols=TRUE, remove_numbers=TRUE,remove_url=TRUE, split_hyphens=TRUE)
token_blog<-tokens_select(token_blog, pattern=stopwords("en"), selection="remove")

token_twit<-tokens(s_twit, remove_punct=TRUE, remove_symbols=TRUE, remove_numbers=TRUE,remove_url=TRUE, split_hyphens=TRUE)
token_twit<-tokens_select(token_twit, pattern=stopwords("en"), selection="remove")
#removing foreign characters
tnews<-iconv(token_news, "latin1", "ASCII",sub="")
tblog<-iconv(token_blog, "latin1", "ASCII", sub="")
ttwit<-iconv(token_twit, "latin1", "ASCII",sub="")
#pasting all tokenized lists together to action together on them
all_token<-c(ttwit,tblog,tnews)
library(stringr)
## Warning: package 'stringr' was built under R version 4.3.2
all_token1<-str_remove(all_token, "^#.+") #remove hashtags
all_token1<-str_remove(all_token1, "^@.+") #remove mentions from Twitter
all_token1<-str_remove(all_token1, "^.+@.+") #remove emails that got missed
all_token1<-tolower(all_token1) #lowercase everything
all_token1<-str_remove(all_token1, "^.*[0-9]+.+") #numbers that got missed because there are non-number characters next to them

Word Frequency

tab<-table(all_token1)
tab_sorted<- tab[order(tab, decreasing=TRUE)]
top_ten<-tab_sorted[1:10]
barplot(top_ten, names.arg=names(top_ten), ylab="Frequency", xlab="Word",main="Word Frequency, Top Ten", las=2)

library(dplyr)
## 
## Attaching package: 'dplyr'
## The following objects are masked from 'package:stats':
## 
##     filter, lag
## The following objects are masked from 'package:base':
## 
##     intersect, setdiff, setequal, union
tabsort<-as.data.frame(tab_sorted)%>%
  mutate(cumsum_pct=cumsum(Freq)/sum(Freq)*100)%>%mutate(id=1:41589)
plot(y=tabsort$cumsum_pct, x=tabsort$id, xlab="Frequency", ylab="Cummulative Percentage")
abline(h=80, lty="dashed", col="red", lwd=2)
abline(v=6150, col="blue", lwd=2)

About 80% of the word body is covered by the top 6,150 most frequent words, or about 15% of the unique words in the corpus.

N-Gram Tokenizing

N-grams are nested combinations of the words in the data set that inform the algorithm how frequently certain words appear after/before certain others.

Constructing the N-Grams

library(stylo)
## Warning: package 'stylo' was built under R version 4.3.2
## 
## ### stylo version: 0.7.4 ###
## 
## If you plan to cite this software (please do!), use the following reference:
##     Eder, M., Rybicki, J. and Kestemont, M. (2016). Stylometry with R:
##     a package for computational text analysis. R Journal 8(1): 107-121.
##     <https://journal.r-project.org/archive/2016/RJ-2016-007/index.html>
## 
## To get full BibTeX entry, type: citation("stylo")
two<-make.ngrams(all_token1, ngram.size=2)
three<-make.ngrams(all_token1, ngram.size=3)
four<-make.ngrams(all_token1, ngram.size=4)
t2<-table(two)
t2_sorted<- t2[order(t2, decreasing=TRUE)]
top2<-t2_sorted[1:10]
t3<-table(three)
t3_sorted<- t3[order(t3, decreasing=TRUE)]
top3<-t3_sorted[1:10]
t4<-table(four)
t4_sorted<- t4[order(t4, decreasing=TRUE)]
top4<-t4_sorted[1:10]

Plotting N-Gram Bar Graphs

library(ggplot2)
## Warning: package 'ggplot2' was built under R version 4.3.2
g_2<-ggplot(as.data.frame(top2), aes(y=Freq, x=two, fill=Freq))
g_2<-g_2+geom_bar(stat="identity")
g_2<-g_2+labs(title="2-grams",x="Words",y="Frequency")
g_2<-g_2+theme(axis.text.x=element_text(angle=90))
plot(g_2)

library(ggplot2)
g_3<-ggplot(as.data.frame(top3), aes(y=Freq, x=three, fill=Freq))
g_3<-g_3+geom_bar(stat="identity")
g_3<-g_3+labs(title="3-grams",x="Words",y="Frequency")
g_3<-g_3+theme(axis.text.x=element_text(angle=90))
plot(g_3)

library(ggplot2)
g_4<-ggplot(as.data.frame(top4), aes(y=Freq, x=four, fill=Freq))
g_4<-g_4+geom_bar(stat="identity")
g_4<-g_4+labs(title="4-grams",x="Words",y="Frequency")
g_4<-g_4+theme(axis.text.x=element_text(angle=90))
plot(g_4)

Conclusions and Next Steps

The cleaned data still has some contamination from missed white space, underscores, etc, and I’m not sure if the place names will muddy up the works. The question of whether or not to remove stopwords—or which library to use in order to remove them—was a complicated one, as well. So, there may need to be some adjustments made to the data cleaning steps after the first round of modeling.

Considering the Pareto graph of cummulative frequency percentage, it may be possible, also, to avoid a lot of the dirt by capping the corpus at 90% or 95% frequency explained.

After modeling is complete, a Shiny app will be constructed that will have the model as the back-end and a user input—probably a text box.