Random sampling

To build models it is not necessary to use all of the data. Often relatively few randomly selected rows or chunks need to be included to get an accurate approximation to results that would be obtained using all the data.

set.seed(190820)

textsample <- c(
  blogs[sample(1:length(blogs),length(blogs)/100, replace = FALSE)], 
  news[sample(1:length(news),length(news)/100, replace = FALSE)], 
  twitter[sample(1:length(twitter),length(twitter)/100, replace = FALSE)])

write(textsample, "output/textsample.txt")

length(textsample)

## [1] 42695

The random subsample consists of 42695 lines.

Cleaning

I am going to use the tm library for perform data cleaning tasks

Convert character vector between encodings

This conversion, which transforms the text to Latin-ASCII, replaces diacritic/accent characters (âêîôûŷŵ äëïöüÿ àèìòù áéíóúý ãñõ ø) and removes all characters that are not a letter, number or common symbols.

textsample2 <- iconv(textsample, from = "", to = "ASCII", sub="")
# sub replaces any non-convertible bytes in the input. 

# load data as a corpus
corpus <- VCorpus(VectorSource(textsample2))
corpus

## <<VCorpus>>
## Metadata:  corpus specific: 0, document level (indexed): 0
## Content:  documents: 42695

Text sample (line 12):

writeLines(as.character(corpus[[12]]))

## I then dealt with the insurance company directly, got them whatever they needed and kept getting stalled about the cheque. Finally I just lost it, told them I cant do business without that money, that Id make it my full time job to show up to their offices and call every TV station I could think of to cover this story if I didnt get my cheque! They seemed pretty alarmed.

Convert text to lower case

This facilitates further cleaning and analysis steps.

corpus <- tm_map(corpus, content_transformer(tolower))

Remove special characters, numbers, punctuations, URLs…

toSpace <- content_transformer(function(x, pattern) gsub(pattern, " ", x))
corpus <- tm_map(corpus, toSpace, "(f|ht)tp(s?)://(.*)[.][a-z]+")
corpus <- tm_map(corpus, toSpace, "@[^\\s]+")

corpus <- tm_map(corpus, removeNumbers)
corpus <- tm_map(corpus, removePunctuation)

remURL <- function(x) gsub("http[[:alnum:]]*", "", x)
corpus <- tm_map(corpus, content_transformer(remURL))

Remove white space

corpus <- tm_map(corpus, stripWhitespace)

Remove stop words

corpus <- tm_map(corpus, removeWords, stopwords("english"))

Profanity filtering

Removes words that we do not want to predict, such as swear words.

profanity_words <- readLines("http://www.bannedwordlist.com/lists/swearWords.txt")

## Warning in readLines("http://www.bannedwordlist.com/lists/swearWords.txt"):
## incomplete final line found on 'http://www.bannedwordlist.com/lists/
## swearWords.txt'

corpus <- tm_map(corpus, removeWords, profanity_words)

Stemming

The process of stemming reduces words to the word stem or root, such as “growing” to “grow”.

corpus <- tm_map(corpus, stemDocument)

This is again the text sample line 12 after the cleaning process:

inspect(corpus[[12]]) 

## <<PlainTextDocument>>
## Metadata:  7
## Content:  chars: 215
## 
## dealt insur compani direct got whatev need kept get stall chequ final just lost told cant busi without money id make full time job show offic call everi tv station think cover stori didnt get chequ seem pretti alarm

Tokenisation

I am going to convert the corpus into a data.frame and then into a long (or tidy) format, with one row for each word from each of the text elements. I will use the unnest_tokens() function from the tidytext package, which splits a column into tokens (one-token-per-row).

d <- data.frame(text=unlist(sapply(corpus, '[', "content")), stringsAsFactors=F)
unigram <- unnest_tokens(d, word, text, token = "words") # unnest_tokens(data.frame, output-column, input-column)

For n-grams the column is split into groups of n-words.

Example: dont worry be happy

• unigram: dont, worry, be, happy
• bigram: dont worry, worry be, be happy
• trigram: dont worry be, worry be happy

bigram <- unnest_tokens(d, ngram, text, token = "ngrams", n = 2)
trigram <- unnest_tokens(d, ngram, text, token = "ngrams", n = 3)

Word cloud

unigram_freq <- data.frame(table(unigram$word))
unigram_freq <- unigram_freq[order(unigram_freq$Freq, decreasing = TRUE),]

wordcloud(unigram_freq$Var1[1:30], unigram_freq$Freq[1:30]) # wordcloud(words,freq)

This word cloud shows the thirty most frequently used words in the corpus. Since this type of visualisation is not very clear, I am going to present the n-gram frequencies with tables and histograms.

Distribution of unigram, bigram and trigram frequencies

nrow(unigram_freq)

## [1] 41534

There are 41534 unique words in this subsample.

kable(unigram_freq[1:15,], col.names = c('word', 'frequency'), row.names = FALSE)  %>%
  kable_styling(bootstrap_options = c("striped"), full_width = FALSE)

Among the top 15 unigrams are the words “get”, “like”, “one”, “just” and “said”.

ggplot(unigram_freq[1:30,], aes(x = reorder(Var1, Freq), y = Freq)) +
   geom_bar(stat = "identity") +
   labs(title = "30 most frequent unigrams",
        subtitle = "SwiftKey company dataset, subsample, n = 41534 unigrams",
        x = "unigrams",
        y = "frequency") +
   coord_flip() +
   theme(panel.background = element_rect(fill = "white"),
         panel.grid = element_line(colour = "grey"))

bigram_freq <- data.frame(table(bigram$ngram))
bigram_freq <- bigram_freq[order(bigram_freq$Freq, decreasing = TRUE),]

nrow(bigram_freq)

## [1] 445891

We can find 445891 unique word combinations in this subsample.

kable(bigram_freq[1:15,], col.names = c('bigram', 'frequency'), row.names = FALSE)  %>%
  kable_styling(bootstrap_options = c("striped"), full_width = FALSE)

Among the top 15 bigrams are common word combinations such as “right now”, “last year”, “dont know” and “cant wait”.

ggplot(bigram_freq[1:30,], aes(x = reorder(Var1, Freq), y = Freq)) +
   geom_bar(stat = "identity") +
   labs(title = "30 most frequent bigrams",
        subtitle = "SwiftKey company dataset, subsample, n = 445891 bigrams",
        x = "bigrams",
        y = "frequency") +
   coord_flip() +
   theme(panel.background = element_rect(fill = "white"),
         panel.grid = element_line(colour = "grey"))

trigram_freq <- data.frame(table(trigram$ngram))
trigram_freq <- trigram_freq[order(trigram_freq$Freq, decreasing = TRUE),]

nrow(trigram_freq)

## [1] 562405

When combining three words there are 62405 unique combinations.

kable(trigram_freq[1:15,], col.names = c('trigram', 'frequency'), row.names = FALSE)  %>%
  kable_styling(bootstrap_options = c("striped"), full_width = FALSE)

The most frequent trigrams are also very common combinations in the every day conversation such as “let us know”, “cant wait see” (here the stopword “the” was removed in the data cleaning process)

ggplot(trigram_freq[1:30,], aes(x = reorder(Var1, Freq), y = Freq)) +
   geom_bar(stat = "identity") +
   labs(title = "30 most frequent trigrams",
        subtitle = "SwiftKey company dataset, subsample, n = 562405 trigrams",
        x = "trigrams",
        y = "frequency") +
   coord_flip() +
   theme(panel.background = element_rect(fill = "white"),
         panel.grid = element_line(colour = "grey"))

More deep diving

For a better understanding of the data I am going to explore a further questions:

• How many unique words do you need in a frequency sorted dictionary to cover 50% of all word instances in the language? 90%?

unigram_freq_cum <- unigram_freq
unigram_freq_cum$cum_freq <- cumsum(unigram_freq$Freq)
unigram_freq_cum$cum_perc <- unigram_freq_cum$cum_freq / sum(unigram_freq_cum$Freq)

# head(unigram_freq_cum[unigram_freq_cum$cum_perc > 0.5,])

a <- nrow(unigram_freq_cum[unigram_freq_cum$cum_perc <= 0.5,]) #583 words
b <- round((nrow(unigram_freq_cum[unigram_freq_cum$cum_perc <= 0.5,]) / nrow(unigram_freq_cum))*100, 2) #0.01403669 --> 1,4 %

print(c(a,b))

## [1] 583.0   1.4

We need 583 unique words to cover 50% of all word instances in the english language. this accounts for 1,4% of all word instances (n = 41534)