library(tidyverse)
## ── Attaching core tidyverse packages ──────────────────────── tidyverse 2.0.0 ──
## ✔ dplyr 1.1.3 ✔ readr 2.1.4
## ✔ forcats 1.0.0 ✔ stringr 1.5.0
## ✔ ggplot2 3.4.3 ✔ tibble 3.2.1
## ✔ lubridate 1.9.2 ✔ tidyr 1.3.0
## ✔ purrr 1.0.2
## ── Conflicts ────────────────────────────────────────── tidyverse_conflicts() ──
## ✖ dplyr::filter() masks stats::filter()
## ✖ dplyr::lag() masks stats::lag()
## ℹ Use the conflicted package (<http://conflicted.r-lib.org/>) to force all conflicts to become errors
library(topicmodels)
library(tidytext)
library(tictoc)
En la minería de texto, suele ser habitual disponer de grandes volúmenes de texto (publicaciones de blogs, artículos de noticias, comentarios, etc.) a los cuales nos gustaría poder “dividir” en grupos naturales para poder entenderlos por separado. El modelado de tópicos es un método para la clasificación no supervisada de dichos documentos, similar a la agrupación de datos numéricos, que encuentra grupos naturales de elementos incluso cuando no estamos seguros de lo que estamos buscando.
Hay una gran cantidad de métodos de modelados de tópicos, hoy vamos a ver uno de los más populares: Latent Dirichlet Allocation (LDA). La idea va a ser tratar cada documento como una mixtura, una mezcla de temas y a cada tema como una mixtura de palabras. Esto permite que los documentos se “superpongan” entre sí en términos de contenido, en lugar de estar separados en grupos discretos, de una manera que refleja el uso típico del lenguaje natural.
LDA es uno de los algoritmos más comunes para el modelado de tópicos Sin sumergirnos en las matemáticas detrás del modelo, podemos entenderlo como guiado por dos principios.
LDA es un método para estimar ambos al mismo tiempo: encontrar la combinación de palabras que está asociada con cada tema, al mismo tiempo que se determina la combinación de temas que describe cada documento. Hay varias implementaciones de este algoritmo y exploraremos una de ellas en profundidad.
Veamos un ejemplo:
revistas <- read_csv('../data/revistas_limpias_final.csv')
## Rows: 3980 Columns: 5
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: ","
## chr (4): categoria, fecha, titulo, text
## dbl (1): id
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
head(revistas)
## # A tibble: 6 × 5
## id categoria fecha titulo text
## <dbl> <chr> <chr> <chr> <chr>
## 1 1 Hombre 4 de marzo de 2018 Los ex caddies que se organiz… "Nin…
## 2 2 Hombre 2 de marzo de 2018 El documental sobre la gran e… "Del…
## 3 3 Hombre 15 de febrero de 2018 Porfolio fotográfico: Guiller… "Las…
## 4 4 Hombre 3 de diciembre de 2017 Pipi Piazzolla, el músico que… "\n\…
## 5 5 Hombre 29 de marzo de 2016 Perfil Geek: hoy Ezequiel Cal… "\nC…
## 6 6 Hombre 28 de marzo de 2016 3 shows imperdibles en Buenos… "\n\…
Vamos a usar el siguiente dataset que contiene artículos tomados de dos revistas con diferentes targets:
Una versión del mismo fue utilizado para el siguiente paper que puede serles de utilidad como una aplicación posible del modelado de tópicos.
Estamos interesados en poder identificar qué temas existen en las revistas para hombres y mujeres cada uno pero no estamos interesados en leer todos los discursos. Por eso vamos a usar LDA en este corpus.
Como vemos, el corpus aún no ha sido procesado. Empecemos, entonces, por ahí y podemos, de paso, repasar las diferentes etapas.
Vamos a normalizar, primero, los campos de texto. Con esta
instrucción cambiamos el encoding de texto de los campos
text
y title
y lo pasamos a ASCII. Esta es una
forma bastante rápida de eliminar tildes, ñ y otros acentos.
revistas <- revistas %>%
mutate(text = stringi::stri_trans_general(text, "Latin-ASCII"),
titulo = stringi::stri_trans_general(titulo, "Latin-ASCII"))
Eliminamos los dígitos que encontremos en el texto…
revistas <- revistas %>%
mutate(text = str_replace_all(text, '[[:digit:]]+', ''))
Ahora podemos tokenizarlo:
revistas_tidy <- revistas %>%
unnest_tokens(word, text)
head(revistas_tidy)
## # A tibble: 6 × 5
## id categoria fecha titulo word
## <dbl> <chr> <chr> <chr> <chr>
## 1 1 Hombre 4 de marzo de 2018 Los ex caddies que se organizaron… ning…
## 2 1 Hombre 4 de marzo de 2018 Los ex caddies que se organizaron… tenia
## 3 1 Hombre 4 de marzo de 2018 Los ex caddies que se organizaron… la
## 4 1 Hombre 4 de marzo de 2018 Los ex caddies que se organizaron… plata
## 5 1 Hombre 4 de marzo de 2018 Los ex caddies que se organizaron… nece…
## 6 1 Hombre 4 de marzo de 2018 Los ex caddies que se organizaron… ni
Hagamos una exploración rápida:
revistas_tidy %>%
group_by(word) %>%
summarise(n=n()) %>%
arrange(desc(n))
## # A tibble: 112,083 × 2
## word n
## <chr> <int>
## 1 de 152420
## 2 que 89337
## 3 la 86281
## 4 y 85932
## 5 en 70293
## 6 el 67110
## 7 a 53494
## 8 un 37559
## 9 los 36885
## 10 con 34517
## # ℹ 112,073 more rows
Vemos que, claramente, tenemos que hacer una limpieza de stopwords.
stop_words <- read_delim('../data/stopwords.txt',
delim = '\t',
col_names = c('word')) %>%
mutate(word=stringi::stri_trans_general(word, "Latin-ASCII"))
## Rows: 732 Columns: 1
## ── Column specification ────────────────────────────────────────────────────────
## Delimiter: "\t"
## chr (1): word
##
## ℹ Use `spec()` to retrieve the full column specification for this data.
## ℹ Specify the column types or set `show_col_types = FALSE` to quiet this message.
## Aquí agregamos algunas palabras al listado de stopwords...
stop_words <- stop_words %>%
bind_rows( tibble(word=c('ano', 'anos', 'ohlala', 'foto', 'the')))
## Ahora, las eliminamos
revistas_tidy <- revistas_tidy %>%
anti_join(stop_words)
## Joining with `by = join_by(word)`
Veamos cómo quedó ahora la distribución de palabras:
revistas_tidy %>%
group_by(word) %>%
summarise(n=n()) %>%
arrange(desc(n))
## # A tibble: 111,484 × 2
## word n
## <chr> <int>
## 1 vida 2835
## 2 mundo 2780
## 3 casa 1925
## 4 argentina 1729
## 5 forma 1674
## 6 historia 1486
## 7 personas 1462
## 8 ciudad 1412
## 9 podes 1392
## 10 tipo 1391
## # ℹ 111,474 more rows
¿Cómo podríamos identificar las palabras más usadas cada grupo de revista?
revistas_tidy %>%
group_by(categoria, word) %>%
summarise(n=n()) %>%
arrange(desc(n)) %>%
pivot_wider(names_from = categoria,
values_from = n)
## `summarise()` has grouped output by 'categoria'. You can override using the
## `.groups` argument.
## # A tibble: 111,484 × 3
## word Hombre Mujer
## <chr> <int> <int>
## 1 mundo 1652 1128
## 2 vida 1289 1546
## 3 argentina 1322 407
## 4 podes 166 1226
## 5 vas 149 1009
## 6 vos 244 971
## 7 casa 962 963
## 8 historia 947 539
## 9 mujeres 299 937
## 10 ciudad 921 491
## # ℹ 111,474 more rows
Ahora sí, estamos en condiciones de avanzar en nuestro modelado de tópicos.
Para hacer el modelado de temas como se implementa aquí, necesitamos
generar una DocumentTermMatrix
, un tipo especial de matriz
del paquete tm (por supuesto, esto es solo una implementación específica
del concepto general de una TFM).
Las filas corresponden a documentos (textos descriptivos en nuestro caso) y las columnas corresponden a términos (es decir, palabras); es una matriz dispersa y los valores son recuentos de palabras. Primero, generamos nuestra tabla tidy de conteos
word_counts <- revistas_tidy %>%
group_by(id, word) %>%
summarise(n=n()) %>%
ungroup()
## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.
head(word_counts)
## # A tibble: 6 × 3
## id word n
## <dbl> <chr> <int>
## 1 1 aag 2
## 2 1 abajo 2
## 3 1 abandonarlo 1
## 4 1 abierto 1
## 5 1 abiertos 1
## 6 1 abre 1
Tenemos hasta aquí nuestra estructura de datos habitual: un token por fila y una columna de conteo. Vamos a transformarla ahora a una TFM:
disc_dtm <- word_counts %>%
cast_dtm(id, word, n)
disc_dtm
## <<DocumentTermMatrix (documents: 3930, terms: 111484)>>
## Non-/sparse entries: 889157/437242963
## Sparsity : 100%
## Maximal term length: NA
## Weighting : term frequency (tf)
Vemos que este conjunto de datos contiene documentos (cada uno de ellos un discurso) y términos (palabras). Observe que esta matriz de documento-término de ejemplo es (muy cercana a) 100% dispersa, lo que significa que casi todas las entradas en esta matriz son cero. Cada entrada distinta de cero corresponde a una determinada palabra que aparece en un determinado documento.
Ahora usemos el paquete topicmodels
para estimar un
modelo LDA. ¿Cuántos temas le diremos al algoritmo que haga? Esta es una
pregunta muy parecida a la de un clustering de k-medias. La respuesta es
desilusionadora: no lo sabemos. No queda otra opción que ir probando.
Por ahora y a los fines prácticos de esta primera aproximación vamos a
probar un modelo muy simple: 4 temas.
lda_4 <- LDA(disc_dtm, k=4, control = list(seed = 1234))
Vemos que entrenar el modelo es simple: una línea de código. Lo difícil viene ahora.
Lo primero que vamos a hacer es tomar la distribución de palabras
para cada tópico. Para construir esa distribución vamos a tomar la
matriz beta
que está dentro del objeto
stm
:
ap_topics <- tidy(lda_4, matrix = "beta") # Si esta línea les tira algún error, hagan install.packages("reshape2")
ap_topics %>%
mutate(beta = round(100*beta,6))
## # A tibble: 445,936 × 3
## topic term beta
## <int> <chr> <dbl>
## 1 1 aag 0
## 2 2 aag 0.000619
## 3 3 aag 0
## 4 4 aag 0
## 5 1 abajo 0.00958
## 6 2 abajo 0.0248
## 7 3 abajo 0.0306
## 8 4 abajo 0.00714
## 9 1 abandonarlo 0
## 10 2 abandonarlo 0.000928
## # ℹ 445,926 more rows
La función tidy
conviritó el modelo a un formato de un
tópico-término por fila. Para cada combinación, el modelo calcula la
probabilidad de que ese término se genere a partir de ese tópico. Por
ejemplo, el término “cesped” tiene una probabilidad de 3.21x10-13 de ser
generado a partir del tema 1. Esta valor baja sensiblemente en el resto
de los tópicos.
Podríamos usar el slice_max()
de dplyr
para
encontrar los 15 términos que son más comunes dentro de cada tema. Dado
que tenemos una tibble, podemos usar una visualización de
ggplot2
.
ap_top_terms <- ap_topics %>%
group_by(topic) %>%
slice_max(beta, n = 15) %>%
ungroup() %>%
arrange(topic, -beta)
ap_top_terms %>%
mutate(term = reorder_within(term, beta, topic)) %>%
ggplot(aes(beta, term, fill = factor(topic))) +
geom_col(show.legend = FALSE) +
facet_wrap(~ topic, scales='free_y') +
scale_y_reordered() +
theme_minimal()
Pareciera que hay dos conjuntos de palabras que tiene un tema bien definido: - el tema 3 parece hablar de cuestiones vinculadas al cuidado del cuerpo (dietas, moda, etc.) - el 4 parece hablar de restaurantes, comidas, vinos, etc.
En cambio, los temas 1 y 2 no parecen tener un sentido tan definido. El 1 parece hablar de cuestiones de pareja y el dos de viajes y familia.
Esto parece un primer indicador de que deberíamos considerar la posibilidad de utilizar un número de tópicos más elevado. No obstante aprovechemos este ejemplo de cuatro tópicos para ver algunas cuestiones más.
La visualización anterior nos permite marcar una observación importante sobre las palabras en cada tema es que algunas palabras, como “mundo” y “vida”, son comunes a más de un tema. Ésta es una ventaja del modelado de temas en comparación con los métodos de “agrupamiento duro”: los temas utilizados en lenguaje natural podrían tener cierta superposición en términos de palabras.
Como alternativa, podríamos considerar los términos que tuvieran la mayor diferencia en \(\beta\) entre el tema 3 y el tema 4 (que son los que mejor podemos interpretar). Esto se puede estimar en función de la relación logarítmica de los dos: \(log_2(\frac{\beta_{4}}{\beta_{3}})\). Utilizar una relación logarítmica es útil porque hace que la diferencia sea simétrica: si \(\beta_{3}\) fuera dos veces mayor produce un log ratio de 1, mientras que si \(\beta_{4}\) es el doble, el resultado es -1). Para restringirlo a un conjunto de palabras especialmente relevantes, podemos filtrar por palabras relativamente comunes, como aquellas que tienen un \(\beta\) mayor que 1/1000 en al menos un tema.
beta_wide <- ap_topics %>%
mutate(topic = paste0("topic", topic)) %>%
pivot_wider(names_from = topic, values_from = beta) %>%
filter(topic3 > .002 | topic4 > .002) %>%
mutate(log_ratio3_4 = log2(topic4 / topic3))
beta_wide
## # A tibble: 22 × 6
## term topic1 topic2 topic3 topic4 log_ratio3_4
## <chr> <dbl> <dbl> <dbl> <dbl> <dbl>
## 1 agua 0.0000993 0.000943 0.00306 0.00121 -1.34
## 2 cuerpo 0.000996 0.00102 0.00267 0.000140 -4.25
## 3 forma 0.00182 0.000988 0.00227 0.00109 -1.07
## 4 mundo 0.00366 0.00259 0.000883 0.00219 1.31
## 5 pelo 0.0000198 0.000434 0.00236 0.0000000242 -16.6
## 6 podes 0.00134 0.000204 0.00224 0.00162 -0.465
## 7 tipo 0.00104 0.00101 0.00226 0.000958 -1.24
## 8 ciudad 0.000585 0.00106 0.000129 0.00335 4.70
## 9 aires 0.000614 0.00132 0.000260 0.00231 3.15
## 10 estilo 0.000427 0.000260 0.00244 0.000925 -1.40
## # ℹ 12 more rows
Si construimos una visualización, vemos que…
beta_wide %>%
ggplot(aes(x=reorder(term,log_ratio3_4) , y=log_ratio3_4)) +
geom_col() +
coord_flip() +
labs(x='Término',
y='Log2 ratio topic4/topic3') +
theme_minimal()
… palabras como “pelo” o “look” caracterizan al tópico 3, mientras que “restaurate” o “cocina” representan al tópico 4. Esto ayuda a confirmar que se trata de dos tópicos diferenciados.
Además de estimar cada tema como una mezcla de palabras, LDA también
modela cada documento como una mezcla de temas. Podemos examinar las
probabilidades por documento por tema, llamadas \(\gamma\), con el argumento
matrix = "gamma"
para tidy()
.
doc_2_topics <- tidy(lda_4, matrix = "gamma")
doc_2_topics %>%
mutate(gamma = round(gamma, 5),
document = as.integer(document)) %>%
arrange(document, desc(gamma))
## # A tibble: 15,720 × 3
## document topic gamma
## <int> <int> <dbl>
## 1 1 2 0.984
## 2 1 4 0.0156
## 3 1 1 0.00005
## 4 1 3 0.00005
## 5 2 2 0.999
## 6 2 1 0.00035
## 7 2 3 0.00035
## 8 2 4 0.00035
## 9 3 1 0.950
## 10 3 4 0.0489
## # ℹ 15,710 more rows
Cada uno de estos valores es una proporción estimada de palabras de ese documento que se generan a partir de ese tema.
Veamos los tópicos 3 y 4:
doc_2_topics %>%
filter(topic == 3 | topic == 4) %>%
mutate(gamma = round(gamma, 5))
## # A tibble: 7,860 × 3
## document topic gamma
## <chr> <int> <dbl>
## 1 1 3 0.00005
## 2 2 3 0.00035
## 3 3 3 0.00036
## 4 4 3 0.00038
## 5 5 3 0.00135
## 6 6 3 0.00015
## 7 7 3 0.00011
## 8 8 3 0.00019
## 9 9 3 0.450
## 10 10 3 0.0002
## # ℹ 7,850 more rows
Por ejemplo, el modelo estima que alrededor del 68% de las palabras en el documento 9 se generaron a partir del tema 3. O menos del 1% de las palabras del documento 1 se generan a partir del tópico 1.
Para verificar esta respuesta, podríamos ordenar la matriz documento-término (ver Capítulo 5.1) y verificar cuáles eran las palabras más comunes en ese documento
revistas_tidy %>%
filter(id==9) %>%
group_by(id, word) %>%
summarise(n=n()) %>%
select(word, n) %>%
arrange(desc(n))
## `summarise()` has grouped output by 'id'. You can override using the `.groups`
## argument.
## Adding missing grouping variables: `id`
## # A tibble: 143 × 3
## # Groups: id [1]
## id word n
## <dbl> <chr> <int>
## 1 9 caldo 4
## 2 9 sabor 3
## 3 9 alimentos 2
## 4 9 cocina 2
## 5 9 concentrado 2
## 6 9 conserva 2
## 7 9 conservantes 2
## 8 9 cubitos 2
## 9 9 cubo 2
## 10 9 glutamato 2
## # ℹ 133 more rows
Se ve como este artículo parecen predominar palabras del tópico 4 (comidas, restaurantes). Veamos el texto completo de este documento:
revistas %>%
filter(id==9) %>%
select(text) %>%
pull()
## [1] "\n\r\n\r\n% de sal, % de verduras. Lo demas son conservantes, colorantes y potenciadores de sabor, como el glutamato monosodico y el inosinato disodico, ambos muy cuestionados.\r\n\r\ncon grasa bovina hidrogenada, almidon de maiz, primer jugo vacuno. ?Contradictorio? El proceso de hidrogenacion, que sirve para conservar, ademas convierte esas grasas en trans o saturadas y las vuelve mas nocivas para el organismo.\r\n\r\nNo se sabe si el inventor fue Nicolas Appert o el quimico aleman Baron Justus von Liebig. El primero habria pensado este alimento en conserva para abastecer en el frente a las tropas napoleonicas en el siglo XVIII. El segundo no es otro que el inventor del concentrado de carne.\r\n\r\nLos principales productores mundiales de cubitos son Unilever y Nestle. Segun Foodnavigator, se trata de la segunda y la tercera empresa en importancia en la produccion de alimentos a nivel mundial. El mercado de los calditos esta tanto o mas concentrado que el de las gaseosas.\r\n\r\nCon kilo de vegetales variados, g de sal, una copa de vino y hierbas frescas podes hacer tu caldo sin aditivos ni conservantes. Cocina horas sin agregar agua a fuego medio, procesa y volve a cocinarlos hora. Por la cantidad de sal no se va a congelar en el freezer. Rinde dos cucharadas por litro.\r\n\r\nCasi todos los caldos del mercado incluyen potenciadores de sabor como el glutamato monosodico oE . Se trata de un producto semisintetico responsable del sabor \"umami\" y acusado de atacar el sistema nervioso central, de generar adiccion y de provocar un malestar bautizado \"sindrome del restaurante chino\".\r\n\r\nDixit. \"Los cubitos de caldo calzarian en el perfil del menu de un astronauta: es una concentracion de un litro en una pastilla de g. Esta es una de las primeras muestras de cocina molecular. Un caldo convertido en polvo en forma de cubo. En Francia se usa sin complejos ni pretensiones\", afirmo el chef venezolano chucho rojas.\r\n\r\nEl caldo en cubo, como muchos productos deshidratados, enlatados o en conserva, fue creado para una situacion de carencia de alimentos y despues readaptado por la industria con la excusa de no perder tiempo. Deberiamos reflexionar, entonces, cada vez que usamos uno de estos productos, en que estamos usando ese tiempo."
Parece verse cómo habla tanto de la comida pero sobre todo es una nota sobre el cuidado del cuerpo: habla de lo malo que son los “cubitos de caldo” en la comida.
Por último, podemos hacer un primer análisis más interesante a partir
de esta matriz “gamma”. Podríamos preguntarnos si existe una composición
diferencial entre los temas de las revistas de hombres y de mujeres.
Para ello, tomamos la matriz gamma, y hacemos un left_join
con la tabla de revistas (en la que teníamos la categoría):
doc_2_topics %>%
rename(id = document) %>% # tenemos que renombrar la columna para que pueda hacerse el join
mutate(id = as.integer(id)) %>%
left_join(revistas %>% select(id, categoria) %>% unique()) %>%
group_by(categoria, topic) %>%
summarise(mean = mean(gamma)*100) %>%
ggplot() +
geom_col(aes(x=topic, y=mean, fill=categoria), position='dodge') +
theme_minimal()
## Joining with `by = join_by(id)`
## `summarise()` has grouped output by 'categoria'. You can override using the
## `.groups` argument.
Vemos cómo las revistas de mujeres parecen concentrarse en los tópicos 1 y 3, mientras que las de hombres, en los tópicos 1, 2 y 4. Siendo el tópico 3 el menos prevalente.