Capstonen Project week 2
Fernando_Almeida
2024-04-07
Introduction
This milestone report presents an exploratory analysis of the data provided for the Natural Language Processing (NPL) capstone project from the Coursera Johns Hopkins Data Science Specialization. The ultimate goal of the project is to develop a user-friendly Shiny app for text prediction. To develop the prediction model, a data set of text files is provided by the company Swiftkey. The data is a corpus of blog, news, and twitter text in English, German, Finnish, and Russian. In this report, we shall perform a basic summary of the English-language data, as well as a study of the N-gram frequency. Finally, we shall outline the plan to use the data for our prediction algorithm.
Library upload
## Warning: package 'knitr' was built under R version 4.3.2## Warning: package 'stringi' was built under R version 4.3.2## Warning: package 'gridExtra' was built under R version 4.3.1## Warning: package 'tm' was built under R version 4.3.3## Carregando pacotes exigidos: NLP## Warning: package 'NLP' was built under R version 4.3.1## Warning: package 'ggplot2' was built under R version 4.3.2##
## Attaching package: 'ggplot2'## The following object is masked from 'package:NLP':
##
## annotate## Warning: package 'kableExtra' was built under R version 4.3.3## Warning: package 'slam' was built under R version 4.3.1Data download
DATA_URL <- 'https://d396qusza40orc.cloudfront.net/dsscapstone/dataset/'
FILE_NAME <- 'Coursera-SwiftKey.zip'
if (!file.exists('data')) {
dir.create('data')
}
if (!file.exists('data/final')) {
temp_file <- tempfile()
download.file(paste0(DATA_URL, FILE_NAME), temp_file)
unzip(temp_file, exdir = 'data')
unlink(temp_file)
}
read_file <- function(file_name) {
con <- file(file_name, open = 'r')
on.exit(close(con))
readLines(con, encoding = "UTF-8", skipNul = TRUE, warn = FALSE)
}
dir <- "D:/Projetos/R/Coursera/datascience/capstone_project/capstone_project/dados/en_US/"
blogs_file <- paste0(dir, 'en_US.blogs.txt')
news_file <- paste0(dir, 'en_US.news.txt')
twitter_file <- paste0(dir, 'en_US.twitter.txt')
blogs <- read_file(blogs_file)
news <- read_file(news_file)
twitter <- read_file(twitter_file)
blogs[1:2]## [1] "In the years thereafter, most of the Oil fields and platforms were named after pagan “gods”."
## [2] "We love you Mr. Brown."news[1:2]## [1] "He wasn't home alone, apparently."
## [2] "The St. Louis plant had to close. It would die of old age. Workers had been making cars there since the onset of mass automotive production in the 1920s."twitter[1:2]## [1] "How are you? Btw thanks for the RT. You gonna be in DC anytime soon? Love to see you. Been way, way too long."
## [2] "When you meet someone special... you'll know. Your heart will beat more rapidly and you'll smile for no reason."Data stats
file_size <- sapply(list(blogs_file, news_file, twitter_file),
function(x) round(file.info(x)$size / 1024 ^ 2))
num_lines <- sapply(list(blogs, news, twitter), length)
num_words <- sapply(list(blogs, news, twitter), stri_stats_latex)[4,]
num_chars <- sapply(list(blogs, news, twitter),
function (x) sum(nchar(x)))
wpl <- lapply(list(blogs, news, twitter), function(x) stri_count_words(x))
names(wpl) <- c('blogs', 'news', 'twitter')
mean_wpl <- sapply(wpl, mean)
cpl <- lapply(list(blogs, news, twitter), function(x) nchar(x))
names(cpl) <- c('blogs', 'news', 'twitter')
mean_cpl <- sapply(cpl, mean)
mean_cpw <- mean_cpl / mean_wpl
max_cpl <- sapply(cpl, max)
summary <- data.frame(
File = c('en_US.blogs.txt', 'en_US.news.txt', 'en_US.twitter.txt'),
Size = paste(file_size , 'MiB'),
Lines = num_lines,
Words = num_words,
Characters = num_chars,
MeanWPL = round(mean_wpl, 1),
MeanCPW = round(mean_cpw, 1),
MaxCPL = round(max_cpl),
row.names = c("blogs", "news", "twitter")
)
kable(summary) %>% kable_styling(position = "left")| File | Size | Lines | Words | Characters | MeanWPL | MeanCPW | MaxCPL | |
|---|---|---|---|---|---|---|---|---|
| blogs | en_US.blogs.txt | 200 MiB | 899288 | 37570839 | 206824505 | 41.8 | 5.5 | 40833 |
| news | en_US.news.txt | 196 MiB | 77259 | 2651432 | 15639408 | 34.6 | 5.8 | 5760 |
| en_US.twitter.txt | 159 MiB | 2360148 | 30451170 | 162096241 | 12.8 | 5.4 | 140 |
get_subset <- function (text) {
name <- deparse(substitute(text))
sample(text, size = summary[name, 'Lines'] * 0.01, replace = FALSE)
}
blogs_subset <- get_subset(blogs)
news_subset <- get_subset(news)
twitter_subset <- get_subset(twitter)
en_subset <- c(blogs_subset, news_subset, twitter_subset)Data transform
# clear up memory
rm(blogs, news, twitter)
rm(cpl, wpl)
rm(blogs_subset, news_subset, twitter_subset)
en_corpus <- VCorpus(VectorSource(en_subset))
removePattern <- content_transformer(function(x, pattern) gsub(pattern, "", x))
en_corpus <- tm_map(en_corpus, removePattern, "(f|ht)tp(s?)://\\S+")
en_corpus <- tm_map(en_corpus, removePattern,
"[[:alnum:]\\.-]+@[[:alnum:].[:alnum:]]+")
en_corpus <- tm_map(en_corpus, removePattern, "@\\S+")
en_corpus <- tm_map(en_corpus, removePattern, "#\\S+")
en_corpus <- tm_map(en_corpus, removePattern, "-")
en_corpus <- tm_map(en_corpus, content_transformer(removePunctuation))
en_corpus <- tm_map(en_corpus, content_transformer(removeNumbers))
en_corpus <- tm_map(en_corpus, content_transformer(tolower))
en_corpus <- tm_map(en_corpus, content_transformer(stripWhitespace))Bad words check
# download bad word file
URL <- 'https://raw.githubusercontent.com/LDNOOBW/List-of-Dirty-Naughty-Obscene-and-Otherwise-Bad-Words/master/en'
if (!file.exists('data/bad_words.csv')) {
download.file(URL, 'data/bad_words.csv')
}
bad_words <- readLines('./data/bad_words.csv')
# remove bad words
removeBadWords <- content_transformer(function(x) removeWords(x, bad_words))
en_corpus <- tm_map(en_corpus, removeBadWords)
UnigramTokenizer <-
function(x) unlist(lapply(ngrams(words(x), 1), paste, collapse = " "))
BigramTokenizer <-
function(x) unlist(lapply(ngrams(words(x), 2), paste, collapse = " "), use.names = FALSE)
TrigramTokenizer <-
function(x) unlist(lapply(ngrams(words(x), 3), paste, collapse = " "), use.names = FALSE)
getFreq <- function(tdm) {
freq <- sort(row_sums(tdm), decreasing = TRUE)
return(data.frame(word = names(freq), freq = freq, row.names = NULL))
}Plots
plotFreq <- function(df, label){
ggplot(df[1:20,], aes(x = reorder(word, -freq), y = freq)) +
geom_bar(stat = "identity") +
theme(axis.text.x = element_text(angle = 45, hjust = 1)) +
labs(x = label, y = "Frequency", title = paste0("Top 20 ", label, "s"))
}
en_corpus %>%
TermDocumentMatrix(control = list(tokenize = UnigramTokenizer)) %>%
getFreq() %>%
plotFreq("Unigram")
en_corpus %>%
TermDocumentMatrix(control = list(tokenize = BigramTokenizer)) %>%
getFreq() %>%
plotFreq("Bigram")
en_corpus %>%
TermDocumentMatrix(control = list(tokenize = TrigramTokenizer)) %>%
getFreq() %>%
plotFreq("Trigram")
unigram_tdm <- TermDocumentMatrix(en_corpus,
control = list(tokenize = UnigramTokenizer))
unigram_freq <- row_sums(unigram_tdm)
num_words <- sum(unigram_freq)
sorted_unigram_freq <- sort(unigram_freq, decreasing = TRUE)
coverage <- cumsum(sorted_unigram_freq) / num_words
df <- as.data.frame(coverage)
df$index <- 1:nrow(df)
cover_90 <- min(which(coverage > 0.9))
cover_95 <- min(which(coverage > 0.95))
cover_99 <- min(which(coverage > 0.99))
ggplot(df, aes(x=index, y=coverage)) +
geom_line() +
xlab("Number of unique words in frequency sorted dictionary") +
ylab("Coverage of word instances") +
geom_segment(aes(x = cover_90, xend = cover_90, y = 0, yend = 0.9), color = 'red') +
geom_segment(aes(x = cover_95, xend = cover_95, y = 0, yend = 0.95), color = 'red') +
geom_segment(aes(x = cover_99, xend = cover_99, y = 0, yend = 0.99), color = 'red') +
geom_segment(aes(x = 0, xend = cover_90, y = 0.9, yend = 0.9), color = 'red') +
geom_segment(aes(x = 0, xend = cover_95, y = 0.95, yend = 0.95), color = 'red') +
geom_segment(aes(x = 0, xend = cover_99, y = 0.99, yend = 0.99), color = 'red') +
geom_point(aes(x = cover_95, y = 0.95)) +
geom_point(aes(x = cover_99, y = 0.99))