This is part 2 of the Swiftkey Next word prediction of the NLP project. I made some models for predicting the next word using the data and variables created during the initial Exploratory Data Analysis reporting. I realised that there are still some numbers and symbols existed after it is being cleaned using the tokens function from Quanteda package. The reason for this is because the numbers and symbols are attached to the words such as ā9AMā, ā@Myā and lots of hashtags.
Regex function in the stringi/stringr package.Please refer to the code appendix below for the detail of the code used to perform the task.
First we download the profanity filter from the CS website
Remove the unwanted number and symbols by performing a low level be using the Regex function in the stringi/stringr package.
To view the relationship between words by using the ngram.function that was described earlier. This is a brief detail of the tokens_ngrams(). We will use this function to create bigram, trigram, quadgram and pentagram to look a the relationship between words. In the initial Exploratory Data Analysis, they were up to quadgram(4 ngram) and to further improve accuracy, I will create a 5 ngram to do some further testing.
## used (Mb) gc trigger (Mb) max used (Mb)
## Ncells 32779132 1750.6 60320641 3221.5 37201280 1986.8
## Vcells 188703312 1439.7 263994180 2014.2 189059157 1442.5
##Create DFM data table (manual)
Data frequency matrix (DFM); also called document-term matrix (DTM). These two terms are synonyms but quanteda refers to a DFM whereas others will refer to DTM. It describes how frequently terms occur in the corpus by counting single terms. To generate a DFM, we first split the text into its single terms (tokens). We then count how frequently each term (token) occurs in each document.
Below is top 30 word frequency plot with Stop words:
Figure: This is a RAW data of blogs, news and Twitter in a single corpus.
Below is top 30 word frequency plot with no Stop words:
Figure: This is a RAW data of blogs, news and Twitter in a single corpus.
As you can see from the the two tables after further data cleaning. Surprisingly after removing the stops words in the second plot, there are still a few stop words such as ātheā and āiā but they are a lot lesser prior to cleaning.
Side by Side comparison of bigram, trigram, quadgram and pentagram wordcloud with stopword.
Side by Side comparison of bigram, trigram, quadgram and pentagram wordcloud without stopword.
As you can see from the the word clouds, the corpuse with stopwords contains more variety than the corpus without stopwords. In the corpus without stopwords, the letter or word āiā dominated the whole ngrams after further data cleaning to remove stopwords. Judging from the wordclouds when the stopwords are removed does not seems to provide a better prediction. We will however use the data without stopwords to make our model for the prediction.
Convert all the ngrams into data table that will consist variables such as features, count, frequency, and coverage.
To improve the performance of our prediction we will reduce the size to cover only word with less than 50% coverage in the data table
The data table of the ngram will be sorted in the descending orders of count, frequency followed by coverage.
We will separate the feature names of the ngrams.
Remove unused variables to speed up performance.
library(knitr) ##Load Knitr package
library(ggplot2) ##Plotting and data
library(caret) ##Load package for ML
library(dplyr) ##Data transformation package
library(quanteda)
library(ngram) ##
library(tm)
library(RColorBrewer)
library(ggthemes)
library(gridExtra)
library(tidytext)
library(wordcloud)
library(markovchain)
library(tidyr)
library(data.table)
library(tidyr)
library(stringi)
library(stringr)
library(plotly)
## Setting Global Option where echo = true so that someone will be able to read the code and results.
knitr::opts_chunk$set(echo = FALSE, results = "hold", tidy = TRUE)
#load(file = "./data/sampleTokenV1.rda")
#load(file = "./data/sampleToken.rda")
load(file = "./data/sampleCorpus.rda")
# Profanity word filter
# Download profanity file from freewebheader
url_1 <- "https://www.cs.cmu.edu/~biglou/resources/bad-words.txt"
filepath_1 <- "./data/profanity_words.txt" #set the location and file name of the downloaded zip file
# Create directory named data for the file to download
if (!file.exists("./data")) {
dir.create("./data")
}
if (!file.exists(filepath_1)){
download.file(url_1, destfile=filepath_1)
}
profanityWords <- readLines("./data/profanity_words.txt", encoding = "UTF-8", skipNul = TRUE)
dict.Profanity <- dictionary(list(badWord = profanityWords))
## Sample Data Cleaning
# remove the special characters that might indicate "Twitter" or other social media conventions.
sample.CorpusV2 <- sample.Corpus %>%
stri_replace_all_regex("[\\p{p}\\p{S}]", "") %>% #remove all punctuation and symbols
stri_replace_all_regex("(\\b)_(\\w+)", "$1$2") %>% #how to remove the leading _
stri_replace_all_regex("\\d", "") #remove all digits
# Remove Stop words
stopwords_regex = paste(stopwords('en'), collapse = '\\b|\\b')
stopwords_regex = paste0('\\b', stopwords_regex, '\\b')
sample.CorpusV3 = stringr::str_replace_all(sample.CorpusV2, stopwords_regex, '')
# Convert to tokens with stopwords
sample.TokenV2 <- tokens(sample.CorpusV2,
remove_numbers = TRUE,
remove_punct = TRUE,
remove_symbols = TRUE,
remove_url = TRUE,
include_docvars = TRUE)
# Convert to tokens without stopwords
sample.TokenV3 <- tokens(sample.CorpusV3,
remove_numbers = TRUE,
remove_punct = TRUE,
remove_symbols = TRUE,
remove_url = TRUE,
include_docvars = TRUE)
# remove profanity words
sample.TokenV2 <- tokens_remove(tokens(sample.TokenV2, dict.Profanity))
sample.TokenV3 <- tokens_remove(tokens(sample.TokenV3, dict.Profanity))
# save the sample token version 2 after low level cleaning
save(sample.TokenV2, file = "./data/clean/sampleTokenV2.rda")
save(sample.TokenV3, file = "./data/clean/sampleTokenV3.rda")
# Remove the variables no longer in use to improve efficiency.
rm(sample.Corpus, sample.CorpusV2, sample.CorpusV3)
# For the the purpose of text analysis, we will create two functions for dfm and ngram to apply to accomplish our task
dfm.Function <- function(corpus, n) {
dfm(x = corpus,
remove = dict.Profanity)
}
ngram.Function <- function(corpus, n) {
tokens_ngrams(corpus,
n = n)
}
## Forloop function to create ngram 1 - 5. One with Stopwords and the other without stopwords
for (i in 1:5) {
## Create unigram, bigram, trigram, quadgram and pentagram data table
ngram <- sample.TokenV2 %>%
ngram.Function(n = i)
#assign name to the ngram ie. unigram as ngram1, bigram as gram2
assign(paste("ngram", i, sep = ""), ngram)
## Create unigram, bigram, trigram,quadgram and pentagram data table (Without Stopwords)
ngram <- sample.TokenV3 %>%
ngram.Function(n = i)
#assign name to the ngram ie. unigram as ngram1, bigram as gram2
assign(paste("ngram.NS", i, sep = ""), ngram)
}
#cleaning duplicate
rm(ngram)
gc()
# DFM Data table with Stopwords
dfm1 <- ngram1 %>%
dfm.Function()
dfm2 <- ngram2 %>%
dfm.Function()
dfm3 <- ngram3 %>%
dfm.Function()
dfm4 <- ngram4 %>%
dfm.Function()
dfm5 <- ngram5 %>%
dfm.Function()
# DFM Data table without stopwords
dfm.NS1 <- ngram.NS1 %>%
dfm.Function()
dfm.NS2 <- ngram.NS2 %>%
dfm.Function()
dfm.NS3 <- ngram.NS3 %>%
dfm.Function()
dfm.NS4 <- ngram.NS4 %>%
dfm.Function()
dfm.NS5 <- ngram.NS5 %>%
dfm.Function()
plot <- dfm1 %>%
topfeatures(30) %>%
as.data.frame()
plot.NS <- dfm.NS1 %>%
topfeatures(30) %>%
as.data.frame()
# Change column name to frequency
colnames(plot) <- "frequency"
colnames(plot.NS) <- "frequency"
# Added a column to the dataframe for plotting purpose
plot$ngram <- row.names(plot)
plot.NS$ngram <- row.names(plot.NS)
## Generate plots for including stopwords sample data
p <- ggplot(plot, aes(y = frequency,
x = reorder(ngram, frequency)))
p <- p + geom_bar(stat = "identity") + coord_flip()
p <- p + ggtitle("Top 30 Frequency of Word in the Data with Stopwords")
p <- p + geom_text(aes(label=frequency),
position = position_stack(vjust = 0.5), color="white", size=3,fontface='bold')
p <- p + ylab("Frequency") + xlab("Word")
p <- p + theme_few()
## Generate plots for the no stopwords sample data
r <- ggplot(plot.NS, aes(y = frequency,
x = reorder(ngram, frequency)))
r <- r + geom_bar(stat = "identity") + coord_flip()
r <- r + ggtitle("Top 30 Frequency of Word in the Data w/o Stopwords")
r <- r + geom_text(aes(label=frequency),
position = position_stack(vjust = 0.5), color="white", size=3,fontface='bold')
r <- r + ylab("Frequency") + xlab("Word")
r <- r + theme_few()
plot(p)
plot(r)
#par(mfrow=c(1,4))
# Create wordcloud of bigram
biCloud <- sample.TokenV2 %>%
ngram.Function(n=2) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 50, colors=brewer.pal(8, "Dark2"))
# Create wordcloud of trigram
triCloud <- sample.TokenV2 %>%
ngram.Function(n=3) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 35, colors=brewer.pal(8, "Dark2"))
# Create wordcloud of quadgram
quadCloud <- sample.TokenV2 %>%
ngram.Function(n=4) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 20, colors=brewer.pal(8, "Dark2"))
pentaCloud <- sample.TokenV2 %>%
ngram.Function(n=5) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 15, colors=brewer.pal(8, "Dark2"))
#par(mfrow=c(1,4))
# Create wordcloud of bigram
biCloud <- sample.TokenV3 %>%
ngram.Function(n=2) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 50, colors=brewer.pal(8, "Dark2"))
# Create wordcloud of trigram
triCloud <- sample.TokenV3 %>%
ngram.Function(n=3) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 35, colors=brewer.pal(8, "Dark2"))
# Create wordcloud of quadgram
quadCloud <- sample.TokenV3 %>%
ngram.Function(n=4) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 20, colors=brewer.pal(8, "Dark2"))
pentaCloud <- sample.TokenV3 %>%
ngram.Function(n=5) %>%
dfm.Function() %>%
textplot_wordcloud(max.words = 15, colors=brewer.pal(8, "Dark2"))
unigram.Dt <- data.table(ngram = featnames(dfm1),
count = colSums(dfm1),
frequency = docfreq(dfm1),
coverage = cumsum(docfreq(dfm1))/sum(docfreq(dfm1)),
key = "ngram")
bigram.Dt <- data.table(ngram = featnames(dfm2),
count = colSums(dfm2),
frequency = docfreq(dfm2),
coverage = cumsum(docfreq(dfm2))/sum(docfreq(dfm2)),
key = "ngram")
trigram.Dt <- data.table(ngram = featnames(dfm3),
count = colSums(dfm3),
frequency = docfreq(dfm3),
coverage = cumsum(docfreq(dfm3))/sum(docfreq(dfm3)),
key = "ngram")
quadgram.Dt <- data.table(ngram = featnames(dfm4),
count = colSums(dfm4),
frequency = docfreq(dfm4),
coverage = cumsum(docfreq(dfm4))/sum(docfreq(dfm4)),
key = "ngram")
pentagram.Dt <- data.table(ngram = featnames(dfm5),
count = colSums(dfm5),
frequency = docfreq(dfm5),
coverage = cumsum(docfreq(dfm5))/sum(docfreq(dfm5)),
key = "ngram")
# No Stopword data table
unigram.NSDt <- data.table(ngram = featnames(dfm.NS1),
count = colSums(dfm.NS1),
frequency = docfreq(dfm.NS1),
coverage = cumsum(docfreq(dfm.NS1))/sum(docfreq(dfm.NS1)),
key = "ngram")
bigram.NSDt <- data.table(ngram = featnames(dfm.NS2),
count = colSums(dfm.NS2),
frequency = docfreq(dfm.NS2),
coverage = cumsum(docfreq(dfm.NS2))/sum(docfreq(dfm.NS2)),
key = "ngram")
trigram.NSDt <- data.table(ngram = featnames(dfm.NS3),
count = colSums(dfm.NS3),
frequency = docfreq(dfm.NS3),
coverage = cumsum(docfreq(dfm.NS3))/sum(docfreq(dfm.NS3)),
key = "ngram")
quadgram.NSDt <- data.table(ngram = featnames(dfm.NS4),
count = colSums(dfm.NS4),
frequency = docfreq(dfm.NS4),
coverage = cumsum(docfreq(dfm.NS4))/sum(docfreq(dfm.NS4)),
key = "ngram")
pentagram.NSDt <- data.table(ngram = featnames(dfm.NS5),
count = colSums(dfm.NS5),
frequency = docfreq(dfm.NS5),
coverage = cumsum(docfreq(dfm.NS5))/sum(docfreq(dfm.NS5)),
key = "ngram")
# Remove word with more than 50% coverage in the data table
unigram.Clean <- unigram.Dt[!(unigram.Dt$coverage>.5)]
bigram.Clean <- bigram.Dt[!(bigram.Dt$coverage>.5)]
trigram.Clean <- trigram.Dt[!(trigram.Dt$coverage>.5)]
quadgram.Clean <- quadgram.Dt[!(quadgram.Dt$coverage>.5)]
pentagram.Clean <- pentagram.Dt[!(pentagram.Dt$coverage>.5)]
unigram.NSClean <- unigram.NSDt[!(unigram.NSDt$coverage>.5)]
bigram.NSClean <- bigram.NSDt[!(bigram.NSDt$coverage>.5)]
trigram.NSClean <- trigram.NSDt[!(trigram.NSDt$coverage>.5)]
quadgram.NSClean <- quadgram.NSDt[!(quadgram.NSDt$coverage>.5)]
pentagram.NSClean <- pentagram.NSDt[!(pentagram.NSDt$coverage>.5)]
unigram.sort <- unigram.Clean[order(-count, -frequency, -coverage)]
bigram.sort <- bigram.Clean[order(-count, -frequency, -coverage)]
trigram.sort <- trigram.Clean[order(-count, -frequency, -coverage)]
quadgram.sort <- quadgram.Clean[order(-count, -frequency, -coverage)]
pentagram.sort <- pentagram.Clean[order(-count, -frequency, -coverage)]
unigram.NSsort <- unigram.NSClean[order(-count, -frequency, -coverage)]
bigram.NSsort <- bigram.NSClean[order(-count, -frequency, -coverage)]
trigram.NSsort <- trigram.NSClean[order(-count, -frequency, -coverage)]
quadgram.NSsort <- quadgram.NSClean[order(-count, -frequency, -coverage)]
pentagram.NSsort <- pentagram.NSClean[order(-count, -frequency, -coverage)]
uniWords <- unigram.sort %>%
separate(ngram, c("word1"), sep = "_")
biWords <- bigram.sort %>%
separate(ngram, c("word1", "word2"), sep = "_")
triWords <- trigram.sort %>%
separate(ngram, c("word1", "word2", "word3"), sep = "_")
quadWords <- quadgram.sort %>%
separate(ngram, c("word1", "word2", "word3", "word4"), sep = "_")
pentaWords <- pentagram.sort %>%
separate(ngram, c("word1", "word2", "word3", "word4", "word5"), sep = "_")
uniWords.NS <- unigram.NSsort %>%
separate(ngram, c("word1"), sep = "_")
biWords.NS <- bigram.NSsort %>%
separate(ngram, c("word1", "word2"), sep = "_")
triWords.NS <- trigram.NSsort %>%
separate(ngram, c("word1", "word2", "word3"), sep = "_")
quadWords.NS <- quadgram.NSsort %>%
separate(ngram, c("word1", "word2", "word3", "word4"), sep = "_")
pentaWords.NS <- pentagram.NSsort %>%
separate(ngram, c("word1", "word2", "word3", "word4", "word5"), sep = "_")
# Remove the variables no longer in use to improve efficiency.
rm(unigram.sort, bigram.sort, trigram.sort, quadgram.sort, pentagram.sort)
rm(unigram.NSsort, bigram.NSsort, trigram.NSsort, quadgram.NSsort, pentagram.NSsort)
rm(unigram.Clean, bigram.Clean, trigram.Clean, quadgram.Clean, pentagram.Clean)
rm(unigram.NSClean, bigram.NSClean, trigram.NSClean, quadgram.NSClean, pentagram.NSClean)
rm(unigram.Dt, bigram.Dt, trigram.Dt, quadgram.Dt, pentagram.Dt)
rm(unigram.NSDt, bigram.NSDt, trigram.NSDt, quadgram.NSDt, pentagram.NSDt)
rm(dfm1, dfm2, dfm3, dfm4, dfm5)
rm(dfm.NS1, dfm.NS2, dfm.NS3, dfm.NS4, dfm.NS5)
rm(ngram1, ngram2, ngram3, ngram4, ngram5)
rm(ngram.NS1, ngram.NS2, ngram.NS3, ngram.NS4, ngram.NS5)
if (!file.exists("./data/clean")) {
dir.create("./data/clean")
}
save(uniWords, file = "./data/clean/uniWords.rda")
save(biWords, file = "./data/clean/biWords.rda")
save(triWords, file = "./data/clean/triWords.rda")
save(quadWords, file = "./data/clean/quadWords.rda")
save(pentaWords, file = "./data/clean/pentaWords.rda")
save(uniWords.NS, file = "./data/clean/uniWordsNS.rda")
save(biWords.NS, file = "./data/clean/biWordsNS.rda")
save(triWords.NS, file = "./data/clean/triWordsNS.rda")
save(quadWords.NS, file = "./data/clean/quadWordsNS.rda")
save(pentaWords.NS, file = "./data/clean/pentaWordsNS.rda")
| Spec | Description |
|---|---|
| OS | Windows 10 Pro - 64 bit |
| CPU | AMD Ryzen 5 - 3400G (4 cores & 8 threads) |
| RAM | 16GB DDR4 3000MHz |
| Storage | 500GB SSD - M.2 NVMe (PCIe) |
| Tool | RStudio |