The goal here is to build a simple model for the relationship between words. This is the first step in building a predictive text mining application. It will explore simple models and discover more complicated modeling techniques.
Build basic n-gram model - using the exploratory analysis you performed, build a basic n-gram model for predicting the next word based on the previous 1, 2, or 3 words.
Build a model to handle unseen n-grams - in some cases people will want to type a combination of words that does not appear in the corpora. Build a model to handle cases where a particular n-gram isn’t observed.
setwd("/Users/sansw/Desktop/myNotes/Data_Science_Specialization/Capstone")
# Load necessary libraries
library(stringr)
library(tidytext)
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
library(ggplot2)
library(wordcloud)
## Loading required package: RColorBrewer
library(RColorBrewer)
setwd("/Users/sansw/Desktop/myNotes/Data_Science_Specialization/Capstone")
# Define the directory containing the text files
directory_path <- "en_US"
# List all text files in the directory
file_list <- list.files(directory_path, pattern = "\\.txt$", full.names = TRUE)
combined_lines <- c()
# Loop through each file
for (file in file_list) {
# Read the entire file into a character vector
lines <- readLines(file, warn = FALSE)
combined_lines <- c(combined_lines,lines)
}
sampled_lines <- sample(combined_lines,round(length(combined_lines)/10000))
preprocess_text <- function(text) {
text %>%
tolower() %>% # Convert to lowercase
str_replace_all("[[:punct:]]", "") %>% # Remove punctuation
str_replace_all(" {2,}", " ") %>% # Replace double (or more) spaces with a single space
str_trim() # Trim whitespace
}
# Clean and tokenize text
cleaned_data <- sapply(sampled_lines, preprocess_text)
cleaned_tibble <- tibble(text = cleaned_data)
# Create n-grams corpus
unigram <- cleaned_tibble %>%
unnest_tokens(unigram, text, token = "ngrams", n = 1) %>%
filter(!is.na(unigram))
bigram <- cleaned_tibble %>%
unnest_tokens(bigram, text, token = "ngrams", n = 2) %>%
filter(!is.na(bigram))
trigram <- cleaned_tibble %>%
unnest_tokens(trigram, text, token = "ngrams", n = 3) %>%
filter(!is.na(trigram))
quadgram <- cleaned_tibble %>%
unnest_tokens(quadgram, text, token = "ngrams", n = 4) %>%
filter(!is.na(quadgram))
unigram_freq <- unigram %>%
count(unigram, sort = TRUE, name='n')
bigram_freq <- bigram %>%
count(bigram, sort = TRUE, name='n')
trigram_freq <- trigram %>%
count(trigram, sort = TRUE, name='n')
quadgram_freq <- quadgram %>%
count(quadgram, sort = TRUE, name='n')
# Calculate probabilities
total_unigrams <- sum(unigram_freq$n)
total_bigrams <- sum(bigram_freq$n)
total_trigrams <- sum(trigram_freq$n)
total_quadgrams <- sum(quadgram_freq$n)
unigram_freq <- unigram_freq %>%
mutate(prob = n / total_unigrams)
bigram_freq <- bigram_freq %>%
mutate(prob = n / total_bigrams)
trigram_freq <- trigram_freq %>%
mutate(prob = n / total_trigrams)
quadgram_freq <- quadgram_freq %>%
mutate(prob = n / total_quadgrams)
par(mfrow = c(1, 1))
# Set color palette
palette <- brewer.pal(8, "Dark2")
# Create the word cloud
wordcloud(words = unigram_freq$unigram,
freq = unigram_freq$prob,
min.freq = 1,
max.words = 500,
random.order = FALSE,
rot.per = 0.35,
scale = c(4, 0.5),
colors = palette,
main = "Unigram Word Cloud")
Katz’s Back-off is a method used in natural language processing, particularly in language modeling, to handle cases where certain n-grams (sequences of words) are not present in the training data.
Katz’s Back-off provides a systematic way to deal with unseen n-grams by “backing off” to lower-order n-grams:
Use Higher-order N-grams First: Start with the highest order (e.g., trigrams) to predict the next word. If the specific trigram is not found, move to the bigram.
Back-off to Lower-order N-grams: If the bigram is also not found, back off to unigrams (individual words).
Assign Probabilities: When backing off, Katz’s method assigns a probability to the lower-order n-grams based on the counts of the higher-order n-grams. This often involves discounting the counts of the higher-order n-grams to allocate some probability mass to the lower-order n-grams.
# Implement Katz's Back-off Function
predict_next_word <- function(input_text) {
# Tokenize input
tokens <- input_text %>% tolower() %>% strsplit(split=" ") %>% unlist()
n <- length(tokens)
# Quadgram prediction
if (n >= 3) {
words <- paste(tokens[(n-2):n], collapse = " ")
cap_quadgram <- paste0("^", words)
quadgram_probs <- quadgram_freq %>%
filter(grepl(cap_quadgram, quadgram)) %>%
arrange(desc(prob))
if (nrow(quadgram_probs) > 0) {
return(quadgram_probs)
}
}
# Trigram prediction
if (n >= 2) {
words <- paste(tokens[(n-1):n], collapse = " ")
cap_trigram <- paste0("^", words)
trigram_probs <- trigram_freq %>%
filter(grepl(cap_trigram, trigram)) %>%
arrange(desc(prob))
if (nrow(trigram_probs) > 0) {
return(trigram_probs)
}
}
# Bigram prediction
if (n >= 1) {
words <- tokens[n]
cap_bigram <- paste0("^", words)
bigram_probs <- bigram_freq %>%
filter(grepl(cap_bigram, bigram)) %>%
arrange(desc(prob))
if (nrow(bigram_probs) > 0) {
return(bigram_probs)
}
}
# Unigram prediction (fallback)
return(unigram_freq %>% arrange(desc(prob)))
}
# Example usage #1
predictions <- predict_next_word("i feel like")
print(predictions)
## # A tibble: 30 × 3
## bigram n prob
## <chr> <int> <dbl>
## 1 like the 4 0.000413
## 2 like this 3 0.000310
## 3 like it 2 0.000207
## 4 like that 2 0.000207
## 5 like to 2 0.000207
## 6 like 15k 1 0.000103
## 7 like a 1 0.000103
## 8 like and 1 0.000103
## 9 like boats 1 0.000103
## 10 like colorado 1 0.000103
## # ℹ 20 more rows
# Example usage #2
predictions <- predict_next_word("was sitting in")
print(predictions)
## # A tibble: 1 × 3
## trigram n prob
## <chr> <int> <dbl>
## 1 sitting in his 1 0.000108
# Example usage #3
predictions <- predict_next_word("i feel")
print(predictions)
## # A tibble: 1 × 3
## trigram n prob
## <chr> <int> <dbl>
## 1 i feel about 1 0.000108
# Example usage #4
predictions <- predict_next_word("hello")
print(predictions)
## # A tibble: 3,333 × 3
## unigram n prob
## <chr> <int> <dbl>
## 1 the 485 0.0480
## 2 to 294 0.0291
## 3 and 247 0.0244
## 4 a 203 0.0201
## 5 i 188 0.0186
## 6 of 180 0.0178
## 7 in 158 0.0156
## 8 for 130 0.0129
## 9 is 100 0.00990
## 10 you 98 0.00970
## # ℹ 3,323 more rows
# Example usage #5
predictions <- predict_next_word("wooooooo")
print(predictions)
## # A tibble: 3,333 × 3
## unigram n prob
## <chr> <int> <dbl>
## 1 the 485 0.0480
## 2 to 294 0.0291
## 3 and 247 0.0244
## 4 a 203 0.0201
## 5 i 188 0.0186
## 6 of 180 0.0178
## 7 in 158 0.0156
## 8 for 130 0.0129
## 9 is 100 0.00990
## 10 you 98 0.00970
## # ℹ 3,323 more rows