library(dplyr)
library(NLP)
library(tm)
library(tidytext)
library(tidyr)
library(quanteda)
library(ggplot2)
library(stringi)

Introduction

Vamos a hacer un reporte completo de lo investigado hasta ahora y de las intenciones e ideas que vamos identificando para el desarrollo de nuestra aplicación de predicción de la ‘Siguiente palabra’.
Partimos de unos datos iniciales proporcionados por ‘HC Corpora’. Tenemos varios idiomas disponibles, pero en principio, solo vamos a tratar los archivos de la carpeta ‘en_US’. En esta carpeta tenemos 3 archivos diferentes: Blogs, News y Twitter (tenemos que abrir uno de ellos en modo binario para poder disfrutar de todos sus datos).

Getting the data

Nos bajamos los datos de la URL proporcionada por Coursera, cargamos los 3 archivos en memoria y podemos observar que su contenido es muy muy grande, entre 150 y 200 Mb cada uno de ellos. Tenemos un total de más de 100 millones de palabras.
Tenemos que decidir el tamaño de la muestra de datos con la que vamos a trabajar, es impensable tratar todos los datos. Vamos a usar el 10% de los datos escogidos al azar. Con este 10% escogido podemos construir un ‘Corpus’ que nos servirá como punto de partida para generar los diferentes n-grams (1,2,3,4…)

memory.limit(size = 16000)
## [1] 16000
set.seed(1313)

conn <- file("https://www.cs.cmu.edu/~biglou/resources/bad-words.txt","r")
df_prof <- readLines(conn)
close(conn)
rm(conn)

porc <- 0.10 # 10%

conn <- file("./final/en_US/en_US.news.txt", open = "rb")
ne <- readLines(conn, encoding = "UTF-8", skipNul = TRUE)
close(conn)
rm(conn)
ne <- iconv(ne,"latin1","ASCII",sub = "")
df_sum_ne <- tibble(file = "News", words_total = sum(stri_count_words(ne)), Mb_total = round(sum(stri_numbytes(ne)) / 1024^2,0))
rm(ne)
if (!file.exists(paste0("./final/en_US/sample/ne.q", porc, ".RData"))) {
  ne_s <- sample(ne, round(porc * length(ne)))
  saveRDS(ne_s, file = paste0("./final/en_US/sample/ne.q", porc, ".RData"))
  rm(ne_s)
}

bl <- readLines("./final/en_US/en_US.blogs.txt", encoding = "UTF-8", skipNul = TRUE)
bl <- iconv(bl,"latin1","ASCII",sub = "")
df_sum_bl <- tibble(file = "Blogs", words_total = sum(stri_count_words(bl)) , Mb_total = round(sum(stri_numbytes(bl)) / 1024^2,0))
rm(bl)
if (!file.exists(paste0("./final/en_US/sample/bl.q", porc, ".RData"))) {
  bl_s <- sample(bl, round(porc * length(bl)))
  saveRDS(bl_s, file = paste0("./final/en_US/sample/bl.q", porc, ".RData"))
  rm(bl_s)
}

tw <- readLines("./final/en_US/en_US.twitter.txt", encoding = "UTF-8", skipNul = TRUE)
tw <- iconv(tw,"latin1","ASCII",sub = "")
df_sum_tw <- tibble(file = "Twitter", words_total = sum(stri_count_words(tw)), Mb_total = round(sum(stri_numbytes(tw)) / 1024^2,0))
rm(tw)
if (!file.exists(paste0("./final/en_US/sample/tw.q", porc, ".RData"))) {
  tw_s <- sample(tw, round(porc * length(tw)))
  saveRDS(tw_s, file = paste0("./final/en_US/sample/tw.q", porc, ".RData"))
  rm(tw_s)
}

rbind(df_sum_ne, df_sum_bl, df_sum_tw)
## # A tibble: 3 x 3
##   file    words_total Mb_total
##   <chr>         <int>    <dbl>
## 1 News       34749301      194
## 2 Blogs      37510168      196
## 3 Twitter    30088605      154
ne <- readRDS(paste0("./final/en_US/sample/ne.q", porc, ".RData"))
bl <- readRDS(paste0("./final/en_US/sample/bl.q", porc, ".RData"))
tw <- readRDS(paste0("./final/en_US/sample/tw.q", porc, ".RData"))

  df_sum_ne <- tibble(file = "News", words_sample = sum(stri_count_words(ne)), Mb_sample = 
round(sum(stri_numbytes(ne)) / 1024^2,0))
  df_sum_bl <- tibble(file = "Blogs", words_sample = sum(stri_count_words(bl)), Mb_sample = round(sum(stri_numbytes(bl)) / 1024^2,0))
  df_sum_tw <- tibble(file = "Twitter", words_sample = sum(stri_count_words(tw)), Mb_sample = round(sum(stri_numbytes(tw)) / 1024^2,0))

rbind(df_sum_ne, df_sum_bl, df_sum_tw)
## # A tibble: 3 x 3
##   file    words_sample Mb_sample
##   <chr>          <int>     <dbl>
## 1 News         3480208        19
## 2 Blogs        3732720        20
## 3 Twitter      3006843        15

Cleaning the data

El contenido de la muestra contiene todo tipo de irregularidades que de no normalizarlas nos harían imposible su análisis. En el propio proceso de ‘Tokenization’ introducimos los siguientes subprocesos de limpieza:
- Eliminar números.
- Eliminar signos de puntuación.
- Eliminar símbolos.
- Eliminar separadores de texto.
- Eliminar particularidades de Twitter.
- Eliminar guiones.
- Convertir todo el texto a minúsculas.
- Eliminar las palabras ‘malsonantes’. (Profanity)

jc.freq = function(x) {
  x = x %>%
    group_by(NextWord) %>%
    summarise(count = dplyr::n()) 
  x = x %>% 
    mutate(freq = count / sum(x$count)) %>% 
    select(-count) %>%
    arrange(desc(freq))
}
jc.toke = function(x, ngramSize = 1) {
  
  # Do some regex magic with quanteda
  tolower(
      quanteda::tokens_remove(
        quanteda::tokens_tolower(
          quanteda::tokens(x,
                       remove_numbers = T,
                       remove_punct = T,
                       remove_symbols = T,
                       remove_separators = T,
                       remove_twitter = T,
                       remove_hyphens = T,
                       remove_url = T,
                       ngrams = ngramSize,
                       concatenator = " "
          )
        )
      ,
      df_prof
      )
  )
}

train <- c(ne,bl,tw)
rm(ne,bl,tw)

train = corpus(train)

if (!file.exists(paste0("./final/en_US/ngrams/1ng.q", porc, ".RData"))) {
  train1 = jc.toke(train)
  dfTrain1 = tibble(NextWord = train1)
  dfTrain1 = jc.freq(dfTrain1)
  saveRDS(dfTrain1,file = paste0("./final/en_US/ngrams/1ng.q", porc, ".RData"))
  rm(train1, dfTrain1)
}

if (!file.exists(paste0("./final/en_US/ngrams/2ng.q", porc, ".RData"))) {
  train2 = jc.toke(train, 2)
  dfTrain2= tibble(NextWord = train2)
  dfTrain2 = jc.freq(dfTrain2) %>%
    separate(NextWord, c('word1', 'NextWord'), " ")
  saveRDS(dfTrain2,file = paste0("./final/en_US/ngrams/2ng.q", porc, ".RData"))
  rm(train2, dfTrain2)
  }

if (!file.exists(paste0("./final/en_US/ngrams/3ng.q", porc, ".RData"))) {
  train3 = jc.toke(train, 3)
  dfTrain3 = tibble(NextWord = train3)
  dfTrain3 = jc.freq(dfTrain3) %>%
    separate(NextWord, c('word1', 'word2', 'NextWord'), " ")
  saveRDS(dfTrain3,file = paste0("./final/en_US/ngrams/3ng.q", porc, ".RData"))
  rm(train3, dfTrain3)
}
if (!file.exists(paste0("./final/en_US/ngrams/4ng.q", porc, ".RData"))) {
  train4 = jc.toke(train, 4)
  dfTrain4 = tibble(NextWord = train4)
  dfTrain4 = jc.freq(dfTrain4) %>%
    separate(NextWord, c('word1', 'word2', 'word3', 'NextWord'), " ")
  rm(train, train1, train2, train3, train4)
  saveRDS(dfTrain4,file = paste0("./final/en_US/ngrams/4ng.q", porc, ".RData"))
  rm(train4, dfTrain4)
}

rm(train)
dfTrain1 <- readRDS(paste0("./final/en_US/ngrams/1ng.q", porc, ".RData"))
dfTrain2 <- readRDS(paste0("./final/en_US/ngrams/2ng.q", porc, ".RData"))
dfTrain3 <- readRDS(paste0("./final/en_US/ngrams/3ng.q", porc, ".RData"))
dfTrain4 <- readRDS(paste0("./final/en_US/ngrams/4ng.q", porc, ".RData"))

Exploratory Analysis

Vamos a examinar las frecuencias de repetición de las palabras en los diferentes n-grams.

dfTrain1.h <- head(dfTrain1,30)
ggplot(dfTrain1.h, aes(reorder(NextWord, -freq), freq)) +
         labs(x = "30 most common unigrams", y = "Frequency") +
         theme(axis.text.x = element_text(angle = 60, size = 12, hjust = 1)) +
         geom_bar(stat = "identity", fill = I("grey50"))

dfTrain2.h <- head(dfTrain2,30)
ggplot(dfTrain2.h, aes(reorder(paste(word1, NextWord), -freq), freq)) +
         labs(x = "30 most common bigrams", y = "Frequency") +
         theme(axis.text.x = element_text(angle = 60, size = 12, hjust = 1)) +
         geom_bar(stat = "identity", fill = I("grey50"))

dfTrain3.h <- head(dfTrain3,30)
ggplot(dfTrain3.h, aes(reorder(paste(word1, word2, NextWord), -freq), freq)) +
         labs(x = "30 most common trigrams", y = "Frequency") +
         theme(axis.text.x = element_text(angle = 60, size = 12, hjust = 1)) +
         geom_bar(stat = "identity", fill = I("grey50"))

dfTrain4.h <- head(dfTrain4,30)
ggplot(dfTrain4.h, aes(reorder(paste(word1, word2, word3, NextWord), -freq), freq)) +
         labs(x = "30 most common tetragrams", y = "Frequency") +
         theme(axis.text.x = element_text(angle = 60, size = 12, hjust = 1)) +
         geom_bar(stat = "identity", fill = I("grey50"))

Nexts steps

Tratando solo el 10% de los datos presumiblemente la accuracy va a dejar mucho que desear, pero si aumentamos el tamaño de la muestra podemos construir unos n-grams muy voluminosos y al aplicarlos nuestro algoritmo, los tiempos de respuesta se pueden disparar y convertir nuestra App en algo lento e inútil.
Redundando en el mismo concepto también podemos aumentar las dimensiones de los n-grams a usar (4), pudiendo construir hasta el 8-n-gram o superior, en este caso lógicamente aumentaríamos la accuracy, pero estaríamos en el mismo caso, los tiempos de respuesta de las búsquedas se dispararían considerablemente.
Veremos que se puede conseguir primero, en un pc domestico y segundo, en el contenedor de App para Shiny.
El algoritmo que vamos a implementar consistiría básicamente en buscar en los n-grams por orden de dimensiones y rescatar las palabras con las frecuencias de uso más altas. Antes de nada, tendríamos que hacer las mismas transformaciones al texto de la App y después lo trataríamos con la siguiente secuencia:
- Para una cadena de texto vacía, buscamos en el 1-n-gram las palabras más usadas.
- Para una cadena de texto de N palabras, buscamos en el (N+1)-n-gram las palabras más usadas.
- …
- Para una cadena de texto de 3 palabras, buscamos en el 4-n-gram las palabras más usadas.
- Para una cadena de texto de 2 palabras, buscamos en el 3-n-gram las palabras más usadas.
- Para una cadena de texto de 1 palabras, buscamos en el 2-n-gram las palabras más usadas.
- Si no hemos encontrado nada en ninguno de los N-n-grams, buscamos en el 1-n-gram las palabras más usadas.