Ahora que tenemos nuestros datos en una matriz de términos, podemos empezar a hacer nuestros análisis.

library(topicmodels)
library(tm)
dtm <- readRDS("./dta/dtm.RDS")

El paquete topicmodels ofrece una función LDA para la estimación de Latent Dirichlet Allocation models. Esta función toma tres argumentos principales: 1. una matriz de términos como la que acabamos de construir, 2. el número de temas que creemos que existen en nuestra base de datos, y 3. el método de estimación. Con ello, nuestro modelo tendría el siguiente aspecto.

lda_model <- LDA(dtm,
              5,
              method="Gibbs")
lda_model

La estimación mediante Gibbs sampler es una forma común de estimar este tipo de modelos, aunque los fundamentos de estos métodos de simulación nos llevaría por derroteros muy alejados de los contenidos del curso. Nos conformaremos por ahora con fijar valores que son razonables pero que seguramente requerirán ajuste para situaciones reales. Lo importante ahora es entender intuitivamente qué hace cada uno de los parámetros y cómo manipularlos si nuestra simulación no funciona correctamente.

Una versión más completa que incorpora detalles de cómo queremos que se ejecute la simulación es la siguiente:

k <- 5
burnin <- 4000
iter <- 2000
thin <- 500
seed <- 2003
nstart <- 1
best <- TRUE
ctrl <- list(nstart=nstart,
            seed=seed,
            best=best,
            burnin=burnin,
            iter=iter,
            thin=thin)

lda_model <- LDA(dtm,
                k,
                method="Gibbs",
                control=ctrl)

Aquí estamos fijando el número de iteraciones que queremos descartar de las estimación final porque forman parte de la transición a la distribución estacionaria (burnin), el número de iteraciones que queremos escoger después de que el modelo haya terminado el burn-in period (iter) y el offset entre iteraciones (thin). El parámetro seed es la semilla del generador de números pseudo-aleatorios.

Ahora que hemos ajustado el modelo, podemos ver la distribución de términos en cada tema

terms(lda_model, 5)

O podemos ver también qué tema se asocia con cada uno de los documentos, si asumimos que el tema de mayor probabilidad es al mismo tiempo el tema común de un documento.

head(topics(lda_model))

Una visión más completa la podemos ver en la matriz gamma que muestra la probabilidad de cada tema en cada documento.

as.data.frame(lda_model@gamma)

Por supuesto, el problema de la estrategia que hemos utilizado es que hemos fijado un número de temas que puede no ser el correcto ¿Cómo escoger cuál es el número de temas si no tenemos información ex ante? La mejor estrategia, al igual que vimos en el caso de los modelos de agrupamiento, es estimar el modelo para un gran número de temas y comprobar qué tan bien cada supuesto ajusta los datos.

El límite en este caso es que cada uno de los modelos consume mucho tiempo. Para esquivar ese problema, lo que haremos será estimar en paralelo un modelo con un número diferente de temas. Dependiendo del número de núcleos que tenga nuestra máquina, esto puede rebajar muy considerablemente el tiempo que tenemos que esperar.

Empezaremos por cargar en nuestra sesión los paquetes de R para realizar computaciones en paralelo.

library(parallel)
library(doMC); library(doParallel)
cl <- makeCluster(detectCores() - 1)
registerDoParallel(cl)

En este caso, hemos definido un cluster de tantos núcleos como tenga la máquina en la que estamos trabajando, reservando uno para el sistema operativo.

Ahora podemos estimar nuestro modelo para una serie de modelos que asumen un número de temas entre 2 y 29.

mlist <- foreach(i=seq(2, 29, 3),
                 .packages="topicmodels",
                 .export=c("ctrl", "dtm")) %dopar% {
    out <- LDA(dtm,
               i,
               method="Gibbs",
               control=ctrl)
    return(out)
}

Aquí estamos usando la función foreach que es similar a for pero intenta enviar cada iteración a un proceso diferente. El número de temas es el índice de la iteración y solo tenemos que tener en cuenta que tenemos que exportar explícitamente los objetos que el cuerpo de la iteración necesita para poder trabajar. Pensad en ello como lo que una nueva sesión de R necesitaría para poder hacer el análisis que hemos solicitado.

Lo que tenemos es una lista mlist que contiene, en cada elemento, el resultado de estimar un modelo LDA con un número diferente de temas ¿Cómo podeoms escoger entre estas alternativas? Las formas más comunes son fijándose en la verosimilitud de cada modelo o en su perplejidad, que es una medida de la capacidad del modelo para capturar la estructura de nuevos datos. Idealmente, haríamos esta estimación usando validación cruzada, que veremos en la segunda mitad del curso, pero por ahora nos limitaremos a ver cómo recuperar estas dos cantidades.

mlogLik <- as.data.frame(as.matrix(lapply(mlist, logLik)))
## mperp <- as.data.frame(as.matrix(lapply(mlist, perplexity)))

Y podemos crear gráficos para ver con más claridad qué tan bien funciona cada modelo:

plot(seq(2, 29, 3),
     unlist(mlogLik),
     xlab="Número de temas",
     ylab="Log-Verosimilitud")
LS0tIAp0aXRsZTogIkFuw6FsaXNpcyBkZSB0ZW1hczogRXN0aW1hY2nDs24iCmRhdGU6ICJgciBmb3JtYXQoU3lzLnRpbWUoKSwgJyVCICVkLCAlWScpYCIKLS0tCgpgYGB7ciBzZXR1cCwgaW5jbHVkZT1GQUxTRSwgY2FjaGU9RkFMU0V9CmtuaXRyOjpvcHRzX2NodW5rJHNldChldmFsID0gRkFMU0UpIApgYGAKCkFob3JhIHF1ZSB0ZW5lbW9zIG51ZXN0cm9zIGRhdG9zIGVuIHVuYSBtYXRyaXogZGUgdMOpcm1pbm9zLCBwb2RlbW9zIGVtcGV6YXIgYQpoYWNlciBudWVzdHJvcyBhbsOhbGlzaXMuIAoKYGBge3J9CmxpYnJhcnkodG9waWNtb2RlbHMpCmxpYnJhcnkodG0pCmR0bSA8LSByZWFkUkRTKCIuL2R0YS9kdG0uUkRTIikKYGBgCgpFbCBwYXF1ZXRlIGB0b3BpY21vZGVsc2Agb2ZyZWNlIHVuYSBmdW5jacOzbiBgTERBYCBwYXJhIGxhIGVzdGltYWNpw7NuIGRlIExhdGVudApEaXJpY2hsZXQgQWxsb2NhdGlvbiBtb2RlbHMuIEVzdGEgZnVuY2nDs24gdG9tYSB0cmVzIGFyZ3VtZW50b3MgcHJpbmNpcGFsZXM6IDEuCnVuYSBtYXRyaXogZGUgdMOpcm1pbm9zIGNvbW8gbGEgcXVlIGFjYWJhbW9zIGRlIGNvbnN0cnVpciwgMi4gZWwgbsO6bWVybyBkZSB0ZW1hcwpxdWUgY3JlZW1vcyBxdWUgZXhpc3RlbiBlbiBudWVzdHJhIGJhc2UgZGUgZGF0b3MsIHkgMy4gZWwgbcOpdG9kbyBkZSBlc3RpbWFjacOzbi4KQ29uIGVsbG8sIG51ZXN0cm8gbW9kZWxvIHRlbmRyw61hIGVsIHNpZ3VpZW50ZSBhc3BlY3RvLiAKCmBgYHtyfQpsZGFfbW9kZWwgPC0gTERBKGR0bSwKICAgICAgICAgICAgICA1LAogICAgICAgICAgICAgIG1ldGhvZD0iR2liYnMiKQpsZGFfbW9kZWwKYGBgCgpMYSBlc3RpbWFjacOzbiBtZWRpYW50ZSBfR2liYnMgc2FtcGxlcl8gZXMgdW5hIGZvcm1hIGNvbcO6biBkZSBlc3RpbWFyIGVzdGUgdGlwbwpkZSBtb2RlbG9zLCBhdW5xdWUgbG9zIGZ1bmRhbWVudG9zIGRlIGVzdG9zIG3DqXRvZG9zIGRlIHNpbXVsYWNpw7NuIG5vcyBsbGV2YXLDrWEKcG9yIGRlcnJvdGVyb3MgbXV5IGFsZWphZG9zIGRlIGxvcyBjb250ZW5pZG9zIGRlbCBjdXJzby4gTm9zIGNvbmZvcm1hcmVtb3MgcG9yCmFob3JhIGNvbiBmaWphciB2YWxvcmVzIHF1ZSBzb24gX3Jhem9uYWJsZXNfIHBlcm8gcXVlIHNlZ3VyYW1lbnRlIHJlcXVlcmlyw6FuCmFqdXN0ZSBwYXJhIHNpdHVhY2lvbmVzIHJlYWxlcy4gTG8gaW1wb3J0YW50ZSBhaG9yYSBlcyBlbnRlbmRlciBpbnR1aXRpdmFtZW50ZQpxdcOpIGhhY2UgY2FkYSB1bm8gZGUgbG9zIHBhcsOhbWV0cm9zIHkgY8OzbW8gbWFuaXB1bGFybG9zIHNpIG51ZXN0cmEgc2ltdWxhY2nDs24gbm8KZnVuY2lvbmEgY29ycmVjdGFtZW50ZS4gCgpVbmEgdmVyc2nDs24gbcOhcyBjb21wbGV0YSBxdWUgaW5jb3Jwb3JhIGRldGFsbGVzIGRlIGPDs21vIHF1ZXJlbW9zIHF1ZSBzZSBlamVjdXRlCmxhIHNpbXVsYWNpw7NuIGVzIGxhIHNpZ3VpZW50ZToKCmBgYHtyfQprIDwtIDUKYnVybmluIDwtIDQwMDAKaXRlciA8LSAyMDAwCnRoaW4gPC0gNTAwCnNlZWQgPC0gMjAwMwpuc3RhcnQgPC0gMQpiZXN0IDwtIFRSVUUKY3RybCA8LSBsaXN0KG5zdGFydD1uc3RhcnQsCiAgICAgICAgICAgIHNlZWQ9c2VlZCwKICAgICAgICAgICAgYmVzdD1iZXN0LAogICAgICAgICAgICBidXJuaW49YnVybmluLAogICAgICAgICAgICBpdGVyPWl0ZXIsCiAgICAgICAgICAgIHRoaW49dGhpbikKCmxkYV9tb2RlbCA8LSBMREEoZHRtLAogICAgICAgICAgICAgICAgaywKICAgICAgICAgICAgICAgIG1ldGhvZD0iR2liYnMiLAogICAgICAgICAgICAgICAgY29udHJvbD1jdHJsKQpgYGAKCkFxdcOtIGVzdGFtb3MgZmlqYW5kbyBlbCBuw7ptZXJvIGRlIGl0ZXJhY2lvbmVzIHF1ZSBxdWVyZW1vcyBkZXNjYXJ0YXIgZGUgbGFzCmVzdGltYWNpw7NuIGZpbmFsIHBvcnF1ZSBmb3JtYW4gcGFydGUgZGUgbGEgdHJhbnNpY2nDs24gYSBsYSBkaXN0cmlidWNpw7NuCmVzdGFjaW9uYXJpYSAoYGJ1cm5pbmApLCBlbCBuw7ptZXJvIGRlIGl0ZXJhY2lvbmVzIHF1ZSBxdWVyZW1vcyBlc2NvZ2VyIGRlc3B1w6lzCmRlIHF1ZSBlbCBtb2RlbG8gaGF5YSB0ZXJtaW5hZG8gZWwgX2J1cm4taW4gcGVyaW9kXyAoYGl0ZXJgKSB5IGVsIF9vZmZzZXRfIGVudHJlCml0ZXJhY2lvbmVzIChgdGhpbmApLiBFbCBwYXLDoW1ldHJvIGBzZWVkYCBlcyBsYSBzZW1pbGxhIGRlbCBnZW5lcmFkb3IgZGUgbsO6bWVyb3MKcHNldWRvLWFsZWF0b3Jpb3MuCgpBaG9yYSBxdWUgaGVtb3MgYWp1c3RhZG8gZWwgbW9kZWxvLCBwb2RlbW9zIHZlciBsYSBkaXN0cmlidWNpw7NuIGRlIHTDqXJtaW5vcyBlbgpjYWRhIHRlbWEKYGBge3J9CnRlcm1zKGxkYV9tb2RlbCwgNSkKYGBgCgpPIHBvZGVtb3MgdmVyIHRhbWJpw6luIHF1w6kgdGVtYSBzZSBhc29jaWEgY29uIGNhZGEgdW5vIGRlIGxvcyBkb2N1bWVudG9zLCBzaQphc3VtaW1vcyBxdWUgZWwgdGVtYSBkZSBtYXlvciBwcm9iYWJpbGlkYWQgZXMgYWwgbWlzbW8gdGllbXBvIGVsIHRlbWEgY29tw7puIGRlCnVuIGRvY3VtZW50by4gCmBgYHtyfQpoZWFkKHRvcGljcyhsZGFfbW9kZWwpKQpgYGAKVW5hIHZpc2nDs24gbcOhcyBjb21wbGV0YSBsYSBwb2RlbW9zIHZlciBlbiBsYSBtYXRyaXogYGdhbW1hYCBxdWUgbXVlc3RyYSBsYQpwcm9iYWJpbGlkYWQgZGUgY2FkYSB0ZW1hIGVuIGNhZGEgZG9jdW1lbnRvLiAKYGBge3J9CmFzLmRhdGEuZnJhbWUobGRhX21vZGVsQGdhbW1hKQpgYGAKClBvciBzdXB1ZXN0bywgZWwgcHJvYmxlbWEgZGUgbGEgZXN0cmF0ZWdpYSBxdWUgaGVtb3MgdXRpbGl6YWRvIGVzIHF1ZSBoZW1vcwpmaWphZG8gdW4gbsO6bWVybyBkZSB0ZW1hcyBxdWUgcHVlZGUgbm8gc2VyIGVsIGNvcnJlY3RvIMK/Q8OzbW8gZXNjb2dlciBjdcOhbCBlcyBlbApuw7ptZXJvIGRlIHRlbWFzIHNpIG5vIHRlbmVtb3MgaW5mb3JtYWNpw7NuIF9leCBhbnRlXz8gTGEgbWVqb3IgZXN0cmF0ZWdpYSwgYWwKaWd1YWwgcXVlIHZpbW9zIGVuIGVsIGNhc28gZGUgbG9zIG1vZGVsb3MgZGUgYWdydXBhbWllbnRvLCBlcyBlc3RpbWFyIGVsIG1vZGVsbwpwYXJhIHVuIGdyYW4gbsO6bWVybyBkZSB0ZW1hcyB5IGNvbXByb2JhciBxdcOpIHRhbiBiaWVuIGNhZGEgc3VwdWVzdG8gYWp1c3RhIGxvcwpkYXRvcy4gCgpFbCBsw61taXRlIGVuIGVzdGUgY2FzbyBlcyBxdWUgY2FkYSB1bm8gZGUgbG9zIG1vZGVsb3MgY29uc3VtZSBtdWNobyB0aWVtcG8uIFBhcmEKZXNxdWl2YXIgZXNlIHByb2JsZW1hLCBsbyBxdWUgaGFyZW1vcyBzZXLDoSBlc3RpbWFyIGVuIHBhcmFsZWxvIHVuIG1vZGVsbyBjb24gdW4KbsO6bWVybyBkaWZlcmVudGUgZGUgdGVtYXMuIERlcGVuZGllbmRvIGRlbCBuw7ptZXJvIGRlIG7DumNsZW9zIHF1ZSB0ZW5nYSBudWVzdHJhCm3DoXF1aW5hLCBlc3RvIHB1ZWRlIHJlYmFqYXIgbXV5IGNvbnNpZGVyYWJsZW1lbnRlIGVsIHRpZW1wbyBxdWUgdGVuZW1vcyBxdWUKZXNwZXJhci4gCgpFbXBlemFyZW1vcyBwb3IgY2FyZ2FyIGVuIG51ZXN0cmEgc2VzacOzbiBsb3MgcGFxdWV0ZXMgZGUgYFJgIHBhcmEgcmVhbGl6YXIKY29tcHV0YWNpb25lcyBlbiBwYXJhbGVsby4gCgpgYGB7cn0KbGlicmFyeShwYXJhbGxlbCkKbGlicmFyeShkb01DKTsgbGlicmFyeShkb1BhcmFsbGVsKQpjbCA8LSBtYWtlQ2x1c3RlcihkZXRlY3RDb3JlcygpIC0gMSkKcmVnaXN0ZXJEb1BhcmFsbGVsKGNsKQpgYGAKCkVuIGVzdGUgY2FzbywgaGVtb3MgZGVmaW5pZG8gdW4gY2x1c3RlciBkZSB0YW50b3MgbsO6Y2xlb3MgY29tbyB0ZW5nYSBsYSBtw6FxdWluYQplbiBsYSBxdWUgZXN0YW1vcyB0cmFiYWphbmRvLCByZXNlcnZhbmRvIHVubyBwYXJhIGVsIHNpc3RlbWEgb3BlcmF0aXZvLiAKCkFob3JhIHBvZGVtb3MgZXN0aW1hciBudWVzdHJvIG1vZGVsbyBwYXJhIHVuYSBzZXJpZSBkZSBtb2RlbG9zIHF1ZSBhc3VtZW4gdW4KbsO6bWVybyBkZSB0ZW1hcyBlbnRyZSAyIHkgMjkuIAoKYGBge3J9Cm1saXN0IDwtIGZvcmVhY2goaT1zZXEoMiwgMjksIDMpLAogICAgICAgICAgICAgICAgIC5wYWNrYWdlcz0idG9waWNtb2RlbHMiLAogICAgICAgICAgICAgICAgIC5leHBvcnQ9YygiY3RybCIsICJkdG0iKSkgJWRvcGFyJSB7CiAgICBvdXQgPC0gTERBKGR0bSwKICAgICAgICAgICAgICAgaSwKICAgICAgICAgICAgICAgbWV0aG9kPSJHaWJicyIsCiAgICAgICAgICAgICAgIGNvbnRyb2w9Y3RybCkKICAgIHJldHVybihvdXQpCn0KYGBgCgpBcXXDrSBlc3RhbW9zIHVzYW5kbyBsYSBmdW5jacOzbiBgZm9yZWFjaGAgcXVlIGVzIHNpbWlsYXIgYSBgZm9yYCBwZXJvIGludGVudGEKZW52aWFyIGNhZGEgaXRlcmFjacOzbiBhIHVuIHByb2Nlc28gZGlmZXJlbnRlLiBFbCBuw7ptZXJvIGRlIHRlbWFzIGVzIGVsIMOtbmRpY2UgZGUKbGEgaXRlcmFjacOzbiB5IHNvbG8gdGVuZW1vcyBxdWUgdGVuZXIgZW4gY3VlbnRhIHF1ZSB0ZW5lbW9zIHF1ZSBleHBvcnRhcgpleHBsw61jaXRhbWVudGUgbG9zIG9iamV0b3MgcXVlIGVsIGN1ZXJwbyBkZSBsYSBpdGVyYWNpw7NuIG5lY2VzaXRhIHBhcmEgcG9kZXIKdHJhYmFqYXIuIFBlbnNhZCBlbiBlbGxvIGNvbW8gbG8gcXVlIHVuYSBudWV2YSBzZXNpw7NuIGRlIGBSYCBuZWNlc2l0YXLDrWEgcGFyYQpwb2RlciBoYWNlciBlbCBhbsOhbGlzaXMgcXVlIGhlbW9zIHNvbGljaXRhZG8uCgpMbyBxdWUgdGVuZW1vcyBlcyB1bmEgbGlzdGEgYG1saXN0YCBxdWUgY29udGllbmUsIGVuIGNhZGEgZWxlbWVudG8sIGVsIHJlc3VsdGFkbwpkZSBlc3RpbWFyIHVuIG1vZGVsbyBMREEgY29uIHVuIG7Dum1lcm8gZGlmZXJlbnRlIGRlIHRlbWFzIMK/Q8OzbW8gcG9kZW9tcyBlc2NvZ2VyCmVudHJlIGVzdGFzIGFsdGVybmF0aXZhcz8gTGFzIGZvcm1hcyBtw6FzIGNvbXVuZXMgc29uIGZpasOhbmRvc2UgZW4gbGEKdmVyb3NpbWlsaXR1ZCBkZSBjYWRhIG1vZGVsbyBvIGVuIHN1IHBlcnBsZWppZGFkLCBxdWUgZXMgdW5hIG1lZGlkYSBkZSBsYQpjYXBhY2lkYWQgZGVsIG1vZGVsbyBwYXJhIGNhcHR1cmFyIGxhIGVzdHJ1Y3R1cmEgZGUgbnVldm9zIGRhdG9zLiBJZGVhbG1lbnRlLApoYXLDrWFtb3MgZXN0YSBlc3RpbWFjacOzbiB1c2FuZG8gdmFsaWRhY2nDs24gY3J1emFkYSwgcXVlIHZlcmVtb3MgZW4gbGEgc2VndW5kYQptaXRhZCBkZWwgY3Vyc28sIHBlcm8gcG9yIGFob3JhIG5vcyBsaW1pdGFyZW1vcyBhIHZlciBjw7NtbyByZWN1cGVyYXIgZXN0YXMgZG9zCmNhbnRpZGFkZXMuIAoKYGBge3J9Cm1sb2dMaWsgPC0gYXMuZGF0YS5mcmFtZShhcy5tYXRyaXgobGFwcGx5KG1saXN0LCBsb2dMaWspKSkKIyMgbXBlcnAgPC0gYXMuZGF0YS5mcmFtZShhcy5tYXRyaXgobGFwcGx5KG1saXN0LCBwZXJwbGV4aXR5KSkpCmBgYAoKWSBwb2RlbW9zIGNyZWFyIGdyw6FmaWNvcyBwYXJhIHZlciBjb24gbcOhcyBjbGFyaWRhZCBxdcOpIHRhbiBiaWVuIGZ1bmNpb25hIGNhZGEKbW9kZWxvOgoKYGBge3J9CnBsb3Qoc2VxKDIsIDI5LCAzKSwKICAgICB1bmxpc3QobWxvZ0xpayksCiAgICAgeGxhYj0iTsO6bWVybyBkZSB0ZW1hcyIsCiAgICAgeWxhYj0iTG9nLVZlcm9zaW1pbGl0dWQiKQpgYGAK