Clasificación supervisada de textos

Note

Objetivo: Introducir modelos supervisados aplicados a texto, implementar Naive Bayes en R y evaluar su desempeño con métricas clásicas de clasificación.

¿Qué es la clasificación supervisada de textos?

La clasificación supervisada es una tarea de aprendizaje automático donde el objetivo es predecir una categoría (etiqueta) para un nuevo texto, a partir de ejemplos previamente etiquetados.

Näive Bayes

Representación de texto

Antes de aplicar un modelo, debemos convertir el texto a una representación numérica:

  • Bolsa de palabras (Bag of Words)
  • TF-IDF (Term Frequency - Inverse Document Frequency)

En este ejemplo vamos a usar TF-IDF con ayuda del paquete textrecipes.

Dataset

Usaremos un dataset simulado con textos cortos y etiquetas de sentimiento (pos o neg).

library(tidytext)
library(tidyverse)
library(tidymodels)
library(textrecipes)
library(discrim)
library(naivebayes)
set.seed(123)

datos <- read_csv("comentarios_clasificados.csv") |> 
  mutate(clase = as.factor(clase))

Dataset

head(datos)
# A tibble: 6 × 2
  texto                                                clase
  <chr>                                                <fct>
1 Muy buena atención, volvería sin dudar ¡Gracias!     pos  
2 Una pérdida de tiempo total Para nada recomendable.  neg  
3 Atención al cliente pésima Fue una sorpresa.         neg  
4 Excelente calidad y servicio                         pos  
5 El producto llegó roto Realmente excelente.          neg  
6 El producto llegó en perfectas condiciones ¡Gracias! pos

Datos de entrenamiento y de prueba

division <- initial_split(datos, prop = 0.5, strata = clase)
datos_train <- training(division)
datos_test <- testing(division)

Preprocesamiento y receta con bigramas y TF-IDF

{recipe} permite definir una secuencia de pasos para procesar los datos

receta <- recipe(clase ~ texto, data = datos_train) %>%
  step_tokenize(texto, token = "ngrams") %>%
  step_stopwords(texto, language = "es") %>%
  step_tfidf(texto)

Modelo Naive Bayes

modelo_nb <- naive_Bayes() %>%
  set_engine("naivebayes") %>%
  set_mode("classification")

Armo el flujo de trabajo (workflow)

Un workflow en tidymodels es una estructura que combina dos cosas:

Una receta + un modelo: que define qué algoritmo se va a usar

Permite asegurarse de que el preprocesamiento y el modelo se apliquen juntos

flujo <- workflow() %>%
  add_model(modelo_nb) %>%
  add_recipe(receta)

Entrenamiento y predicción final

modelo_final <- fit(flujo, data = datos_train)

predicciones <- predict(modelo_final, new_data = datos_test, type = "prob") %>%
  bind_cols(predict(modelo_final, new_data = datos_test)) %>%
  bind_cols(datos_test)

Evaluación del rendimiento

predicciones %>%
  conf_mat(truth = clase, estimate = .pred_class)
          Truth
Prediction neg pos
       neg  12  25
       pos  13   0
predicciones %>%
  metrics(truth = clase, estimate = .pred_class)
# A tibble: 2 × 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary          0.24
2 kap      binary         -0.52

Regresión logística ¿Mejorará?

modelo_log <- logistic_reg() %>%
  set_engine("glm") %>%
  set_mode("classification")

flujo <- workflow() %>%
  add_model(modelo_log) %>%
  add_recipe(receta)

Aplico el modelo

modelo_final <- fit(flujo, data = datos_train)

predicciones <- predict(modelo_final, new_data = datos_test, type = "prob") %>%
  bind_cols(predict(modelo_final, new_data = datos_test)) %>%
  bind_cols(datos_test)

predicciones %>%
  conf_mat(truth = clase, estimate = .pred_class)
          Truth
Prediction neg pos
       neg  25   3
       pos   0  22
predicciones %>%
  metrics(truth = clase, estimate = .pred_class)
# A tibble: 2 × 3
  .metric  .estimator .estimate
  <chr>    <chr>          <dbl>
1 accuracy binary          0.94
2 kap      binary          0.88

Otros modelos para clasificación de texto

  • logistic_reg()

  • naive_Bayes()

  • vm_linear()

  • rand_forest()

  • boost_tree() con engine = “xgboost”

N-grams

Tokenización

datos_bigrams <- datos %>%
  unnest_tokens(bigram, texto, token = "ngrams", n = 2) %>%
  filter(!is.na(bigram))

datos_bigrams
# A tibble: 600 × 2
   clase bigram           
   <fct> <chr>            
 1 pos   muy buena        
 2 pos   buena atención   
 3 pos   atención volvería
 4 pos   volvería sin     
 5 pos   sin dudar        
 6 pos   dudar gracias    
 7 neg   una pérdida      
 8 neg   pérdida de       
 9 neg   de tiempo        
10 neg   tiempo total     
# ℹ 590 more rows

Bigramas más comunes

datos_bigrams %>%
  count(bigram, sort = TRUE)
# A tibble: 156 × 2
   bigram                  n
   <chr>               <int>
 1 lo que                 15
 2 nada recomendable      13
 3 para nada              13
 4 no lo                  11
 5 definitivamente sí      9
 6 el producto             9
 7 producto llegó          9
 8 realmente excelente     9
 9 totalmente conforme     9
10 calidad y               8
# ℹ 146 more rows

Eliminamos stopwords

library(tidyr)

bigrams_separated <- datos_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ")

bigrams_filtered <- bigrams_separated %>%
  filter(!word1 %in% stop_words$word) %>%
  filter(!word2 %in% stop_words$word)

bigram_counts <- bigrams_filtered %>% 
  count(word1, word2, sort = TRUE)

bigram_counts
# A tibble: 132 × 3
   word1           word2            n
   <chr>           <chr>        <int>
 1 nada            recomendable    13
 2 para            nada            13
 3 definitivamente sí               9
 4 el              producto         9
 5 producto        llegó            9
 6 realmente       excelente        9
 7 totalmente      conforme         9
 8 excelente       calidad          8
 9 fue             una              8
10 jamás           volveré          8
# ℹ 122 more rows

También puede interesar que sean 3 palabras consecutivas

datos %>%
  unnest_tokens(trigram, texto, token = "ngrams", n = 3) %>%
  filter(!is.na(trigram)) %>%
  separate(trigram, c("word1", "word2", "word3"), sep = " ") %>%
  filter(!word1 %in% stop_words$word,
         !word2 %in% stop_words$word,
         !word3 %in% stop_words$word) %>%
  count(word1, word2, word3, sort = TRUE)
# A tibble: 137 × 4
   word1     word2     word3            n
   <chr>     <chr>     <chr>        <int>
 1 para      nada      recomendable    13
 2 el        producto  llegó            9
 3 fue       una       sorpresa         8
 4 nunca     llegó     lo               8
 5 caro      para      lo               7
 6 demasiado caro      para             7
 7 encantó   la        película         7
 8 joya      repetiría sin              7
 9 la        disfruté  mucho            7
10 la        película  la               7
# ℹ 127 more rows

Es útil para análisis exploratorio de texto

bigrams_filtered %>%
  filter(word2 == "recomendable") %>%
  count(word1, sort = TRUE)
# A tibble: 2 × 2
  word1     n
  <chr> <int>
1 nada     13
2 muy       4

¿Cómo se relacionan las palabras?

library(igraph)
library(ggraph)

bigram_counts %>%
  filter(n > 2) %>%
  graph_from_data_frame() |> 
  ggraph(layout = "fr") +
  geom_edge_link() +
  geom_node_point() +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1)

Más bonito

a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
bigram_counts %>%
  filter(n > 5) %>%
  graph_from_data_frame() |> 
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = n), show.legend = FALSE,
                 arrow = a, end_cap = circle(.07, 'inches')) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), vjust = 1, hjust = 1) +
  theme_void()

Correlación

datos_corr <- datos |> 
  mutate(tipo_comentario = ifelse(clase == "pos", 1, 2)) %>%
  unnest_tokens(word, texto) %>%
  filter(!word %in% stop_words$word)

Conteo por pares

library(widyr)

word_pairs <- datos_corr %>%
  pairwise_count(word, tipo_comentario, sort = TRUE)

word_pairs %>%
  filter(item1 == "producto")
# A tibble: 79 × 3
   item1    item2            n
   <chr>    <chr>        <dbl>
 1 producto muy              2
 2 producto atención         2
 3 producto volvería         2
 4 producto gracias          2
 5 producto una              2
 6 producto para             2
 7 producto nada             2
 8 producto recomendable     2
 9 producto fue              2
10 producto sorpresa         2
# ℹ 69 more rows

Correlación por pares - Coeficiente Phi

El coeficiente phi es una medida común de correlación binaria. El coeficiente phi se centra en la probabilidad de que aparezcan las palabras X e Y, o ninguna , que de que una aparezca sin la otra.

word_cors <- datos_corr %>%
  group_by(word) %>%
  filter(n() >= 5) %>%
  pairwise_cor(word, tipo_comentario, sort = TRUE)

word_cors
# A tibble: 3,306 × 3
   item1     item2 correlation
   <chr>     <chr>       <dbl>
 1 sin       buena           1
 2 dudar     buena           1
 3 calidad   buena           1
 4 servicio  buena           1
 5 joya      buena           1
 6 repetiría buena           1
 7 pensarlo  buena           1
 8 encantó   buena           1
 9 película  buena           1
10 disfruté  buena           1
# ℹ 3,296 more rows

Observamos

word_cors %>%
  filter(item1 == "atención")
# A tibble: 57 × 3
   item1    item2        correlation
   <chr>    <chr>              <dbl>
 1 atención muy                  NaN
 2 atención buena                NaN
 3 atención volvería             NaN
 4 atención sin                  NaN
 5 atención dudar                NaN
 6 atención gracias              NaN
 7 atención una                  NaN
 8 atención para                 NaN
 9 atención nada                 NaN
10 atención recomendable         NaN
# ℹ 47 more rows

Palabras mas asociadas

plot <- word_cors %>%
  filter(item1 %in% c("comida", "servicio", "cliente")) %>%
  group_by(item1) %>%
  ungroup() %>%
  drop_na(correlation) |> 
  mutate(item2 = reorder(item2, correlation)) %>%
  ggplot(aes(item2, correlation)) +
  geom_bar(stat = "identity") +
  facet_wrap(~ item1, scales = "free") +
  coord_flip()

Palabras mas asociadas

plot

Graficamos palabras más relacionadas

set.seed(2016)
plot <- word_cors %>%
  drop_na(correlation) |> 
  filter(correlation > .35) %>%
  graph_from_data_frame() %>%
  ggraph(layout = "fr") +
  geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
  geom_node_point(color = "lightblue", size = 5) +
  geom_node_text(aes(label = name), repel = TRUE) +
  theme_void()

Graficamos palabras más relacionadas

plot

Fin