Analizando datos capturados desde rtweet (twitter) con kerasformula
¿De dónde salió esto?
Toda esta notebook se basa en una entrada de blog de R Studio. Allí hay varias más que valen dedicarle un tiempo.
La entrada, a su vez, se basa en un artículo del blog de R Studio acerca de TensorFlow y KMS (en casod de que uno no haya instalado KMS, por favor, simplemente procede con el habitual ‘install.packages(“kerasformula”)’ o ‘devtools::install_github(“rdrr1990/kerasformula”)’) para tener la última versión directamente desde el repo.
Empecemos:
Lo primero que vamos a hacer es mirar, no #rstat como lo hacen en el post, sino tweets sobre la Copa Mundial de Fútbol de la FIFA Rusia 2018
- Para ello cargamos la librería Keras:
library(kerasformula)## Loading required package: keras## Loading required package: 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## Loading required package: Matrix- Buscamos ahora tweets con el hashtag ‘#rusia2018’. En caso de que no tengas instalado rtweet y por tanto no tengas el token de acceso, por favor sigue este artículo
library(rtweet)
# No correr las líneas comentadas (#) si ya se obtuvieron los datos con rtweet
#frwc <- search_tweets("#rusia2018", n = 18000, include_rts = FALSE) # obtenemos los tweets
#saveRDS(frwc, "./tweets/fifa_russia_wc_1.rds") # guardamos los tweets
frwc <- readRDS("./tweets/fifa_russia_wc_1.rds")
dim(frwc)## [1] 11776 87En el blog dicen que supongamos que nuestro objetivo es medir que tan popular va a ser un tweet basándonos en qué tanto el tweet fue ‘retwitteado’ y ‘faveado’; medidas estas que se correlacionan fuertemente. Veamos qué tanto…
cor(frwc$favorite_count, frwc$retweet_count, method = "spearman")## [1] 0.619228Me limitaré a decir que, en el caso de estos datos, hay correlación, sin calificarla o clasificarla.
Vamos a ver mejor -como en el blog original- las densidades de ‘faveos’ (favorite_count o las veces que le dan ‘me gusta’ o en el corazón) en azul y de retwitteos en verde:
library(ggplot2)
ggplot(frwc, aes(log10(favorite_count + 1))) + geom_density(fill = "green3", alpha = 0.4) + geom_density(aes(log10(retweet_count + 1)), fill = "blue3", alpha = 0.4) + ggtitle("Densidades de faveos y retwitteos", subtitle = "en escala logarítmica de base 10") + xlab("Escala: logaritmo base 10")
Siguiendo el blog, supongamos que queremos poner los tweets en categorías, basándonos en su popularidad, pero no estamos seguros aun del nivel de detalle al que queremos distinguir. Algunos de los datos, como rstats$mentions_screen_name, son realmente una lista con un número de elementos variables por tweet: cada tweet, en esa variable, trae una lista de las personas (mentions_screen_name) mencionadas.
Por tanto, vamos a seguirlos en la escritura de una función de ayuda que cuente todas las entradas en esa variable que sean no-NA: las válidas.
Lo primero es crear un función que nos devuelva el número de elementos que la lista contiene. Y luego creamos una lista de intervalos en los que vamos a categorizar o clasificar las lista según su longitud: así (-1, 0], (0, 1], (1, 10], (10, 100], (100, 1000], (1000, 10000]
A esto se refería el blog cuando decía que “no estamos seguros aun del nivel de detalle al que queremos distinguir”: estos intervalos son fácilmente ajustables.
Ahora sí vamos a correr cierto tipo de regresión con KMS. En tal regresión los valores que toma la variable dependiente es el intervalo en el que cae cada tweet de acuerdo con el valor de la suma de sus rwtwitteos y faveos (retweet_count + favorite_count): sumamos retweet_count y favorite_count para cada uno de los tweets, y lo ponemos de acuerdo con eso en uno de los intervalos: es el paso de una variable continua a una categórica, lo cual conlleva una pérdida de precisión (quizá innecesaria) a cambio de una ganancia en el cómputo requerido.
Las variables independientes, por su parte, van a ser variables creadas a partir de las del set de datos:
- screen_name: el nombre de quien twittea.
- source: tipo de dispositivo desde el que se twitteó.
- n(hashtags): este número nos los da la recien creada función que cuenta el número de elementos de una lista.
- n(mentions_screen_name): este número nos los da la recien creada función que cuenta el número de elementos de una lista.
- n(urls_url): este número nos los da la recien creada función que cuenta el número de elementos de una lista.
- nchar(text): número de caracteres que tiene el tweet.
- grepl(‘photo’, media_type) TRUE or FALSE (0 or 1) si el tweet lleva foto o no, calculado a partir de si la variable ‘media_type’ lleva o no la palabra ‘photo’.
- weekdays(created_at): en qué día fue publicado el tweet. Para este ejercicio, dada la cantidad de tweets por la fiebre mundialista y las políticas de la API de Twitter, todos los tweets recopilados son del mismo día, por tanto la variable no es utilizable.
- format(created_at, ‘%H’): La hora en la que el tweet fué publicado.
Para el entrenamiento:
- definimos la función de ayuda-conteo,
- los intervalos y
- pasamos a kms la variable dependiente (‘cut(retweet_count + favorite_count, breaks)’) y
- le decimos que lo haga contra (‘~’) todas las variables dependientes (screen_name + source +
n(hashtags) + n(mentions_screen_name) + n(urls_url) + nchar(text) + grepl(‘photo’, media_type) + #weekdays(created_at) + # esto está comentado porque la variable no es útil format(created_at, ‘%H’))
# Aquí creamos la función de ayuda que devuelve el número de elementos de un objeto cuya promesa es una lista:
# Cuántos elementos tiene una lista.
n <- function(x) {
unlist(lapply(x, function(y){length(y) - is.na(y[1])}))
}
breaks <- c(-1, 0, 1, 10, 100, 1000, 10000)
popularity <- kms(cut(retweet_count + favorite_count, breaks) ~ screen_name + source +
n(hashtags) + n(mentions_screen_name) +
n(urls_url) + nchar(text) +
grepl('photo', media_type) +
#weekdays(created_at) + # esto está comentado porque la variable no es útil
format(created_at, '%H'), frwc)## Model Matrix size: 0.8 Gb## N: 11776, P: 9524## Set session seed to 8646285## y appears categorical. Proceeding with multinomial classification.## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 256) 2438400
## ___________________________________________________________________________
## dropout_1 (Dropout) (None, 256) 0
## ___________________________________________________________________________
## dense_2 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dropout_2 (Dropout) (None, 128) 0
## ___________________________________________________________________________
## dense_3 (Dense) (None, 6) 774
## ===========================================================================
## Total params: 2,472,070
## Trainable params: 2,472,070
## Non-trainable params: 0
## ___________________________________________________________________________## starting httpd help server ...## doneAl correr, KMS devuelve los parámetros y las métricas del modelo, que realmente no es una regresión lineal sino una perceptrón de dos capas totalmente conectado, la primera de 256 neuronas y la segunda de 128 y con un dropout de 0.5 después de cada capa (a two layers dense (fully connected) network, with 256 and 128 neurons by layer with a drop-out of 0.5).
Veamos ahora algunas métricas de desempeño del modelo: las curvas que en R Studio se ven en el visualizador mientras el modelos e entrena y una matriz de confusión.
plot(popularity$history) + ggtitle(paste("#russia2018 popularity:",
paste0(round(100*popularity$evaluations$acc, 1), "%"),
"out-of-sample accuracy")) + theme_minimal()
popularity$confusion##
## (-1,0]_pred (0,1]_pred (1,10]_pred (10,100]_pred
## (-1,0]_obs 1542 0 24 11
## (0,1]_obs 312 0 8 0
## (1,10]_obs 335 0 18 7
## (10,100]_obs 91 0 9 13
## (100,1e+03]_obs 20 0 5 3
## (1e+03,1e+04]_obs 1 0 4 0
##
## (100,1e+03]_pred (1e+03,1e+04]_pred
## (-1,0]_obs 0 0
## (0,1]_obs 0 0
## (1,10]_obs 0 0
## (10,100]_obs 0 0
## (100,1e+03]_obs 0 0
## (1e+03,1e+04]_obs 0 0Dados los resultados, aplicamos las mismas medidas del blog original: pasamos más intervalos para darle mayor nivel de detalle (exige más cómputo). Y reducimos el número de epochs o rondas de entrenamiento:
breaks <- c(-1, 0, 1, 25, 50, 75, 100, 500, 1000, 10000)
popularity <- kms(cut(retweet_count + favorite_count, breaks) ~
n(hashtags) + n(mentions_screen_name) + n(urls_url) +
nchar(text) +
screen_name + source +
grepl('photo', media_type) +
#weekdays(created_at) +
format(created_at, '%H'), frwc, Nepochs = 10)## Model Matrix size: 0.8 Gb## N: 11776, P: 9524## Set session seed to 20543482## y appears categorical. Proceeding with multinomial classification.## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 256) 2438400
## ___________________________________________________________________________
## dropout_1 (Dropout) (None, 256) 0
## ___________________________________________________________________________
## dense_2 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dropout_2 (Dropout) (None, 128) 0
## ___________________________________________________________________________
## dense_3 (Dense) (None, 9) 1161
## ===========================================================================
## Total params: 2,472,457
## Trainable params: 2,472,457
## Non-trainable params: 0
## ___________________________________________________________________________plot(popularity$history) + ggtitle(paste("#russia2018 popularity (new breakpoints):",
paste0(round(100*popularity$evaluations$acc, 1), "%"),
"out-of-sample accuracy")) + theme_minimal()
En nuestro caso, con las medidas tomadas, la precisión del modelo decae; caso contrario de lo que pasa con el set de datos tomados en el blog.
Supongamos ahora que queremos adicionar más datos.
Lo primero es guardar la fórmula:
pop_input <- "cut(retweet_count + favorite_count, breaks) ~
n(hashtags) + n(mentions_screen_name) + n(urls_url) +
nchar(text) +
screen_name + source +
grepl('photo', media_type) +
#weekdays(created_at) +
format(created_at, '%H')"Aquí usamos ‘paste0’ para añadir elementos a la fórmula previamente guardada haciendo loops sobre los IDs de los usuarios, tipo “grepl(”12233344455556“, mentions_user_id)”. Y así incluímos el número de menciones.
mentions <- unlist(frwc$mentions_user_id) # extract all mentions
mentions <- unique(mentions[which(table(mentions) > 5)]) # remove duplicates and infrequent mentions
mentions <- mentions[!is.na(mentions)] # drop NA
# add
for(i in mentions)
pop_input <- paste0(pop_input, " + ", "grepl(", i, ", mentions_user_id)")
popularity <- kms(pop_input, frwc)## Model Matrix size: 0.8 Gb## N: 11776, P: 9538## Set session seed to 41928866## y appears categorical. Proceeding with multinomial classification.## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 256) 2441984
## ___________________________________________________________________________
## dropout_1 (Dropout) (None, 256) 0
## ___________________________________________________________________________
## dense_2 (Dense) (None, 128) 32896
## ___________________________________________________________________________
## dropout_2 (Dropout) (None, 128) 0
## ___________________________________________________________________________
## dense_3 (Dense) (None, 9) 1161
## ===========================================================================
## Total params: 2,476,041
## Trainable params: 2,476,041
## Non-trainable params: 0
## ___________________________________________________________________________Podríamos adicionar más datos de manera similar, pero pasemos a hora a la manera en que se nos permite modificar la red neuronal, para subsanar el overfitting o el bias que se nos esté presentando. Podemos definir el número capas, el de unidades por capa, las funciones de activación y los dropout. Todo ello reciclando la fórmula, lo cual nos permite iteraciones muy rápidas.
En el caso de este set de datos, realmente vemos que la red es todavía muy simple. Vamos a probar una más compleja, a pesar de que requiere mayor cómputo:
popularity <- kms(pop_input, frwc,
layers = list(units = c(512, 512, 128, NA),
activation = c("relu", "relu", "relu", "softmax"),
dropout = c(0.5, 0.45, 0.4, NA)))## Model Matrix size: 0.8 Gb## N: 11776, P: 9538## Set session seed to 615642## y appears categorical. Proceeding with multinomial classification.## ___________________________________________________________________________
## Layer (type) Output Shape Param #
## ===========================================================================
## dense_1 (Dense) (None, 512) 4883456
## ___________________________________________________________________________
## dropout_1 (Dropout) (None, 512) 0
## ___________________________________________________________________________
## dense_2 (Dense) (None, 512) 262144
## ___________________________________________________________________________
## dropout_2 (Dropout) (None, 512) 0
## ___________________________________________________________________________
## dense_3 (Dense) (None, 128) 65536
## ___________________________________________________________________________
## dropout_3 (Dropout) (None, 128) 0
## ___________________________________________________________________________
## dense_4 (Dense) (None, 9) 1152
## ===========================================================================
## Total params: 5,212,288
## Trainable params: 5,212,288
## Non-trainable params: 0
## ___________________________________________________________________________Con estos parámetros hay mucho overfitting o sobre ajuste. Podríamos intentar otras arquitecturas de la manera que ya hemos visto.
Lo que encuentro de utilidad es que, en comparación con el uso directo de Keras a través de la API para R, requiere menos preprocesamiento, lo cual facilita mucho la iteración; aunque limita mucho en cuanto a las arquitecturas disponibles. Esto lo digo teniendo en cuenta mi conocimiento de la API de Keras, que no es la de un experto.
Por otra parte, en comparación con lo que podemos hacer en h2o, considero que es mucho más eficiente h2o para estos modelos; además de que h2o nos permite ver aspectos como la importancia de las variables.
Espero pronto hacer el mismo ejercicio en h2o, como complemento a este post.
Quedo atento a comentarios y sugerencias. Gracias por seguirme hasta aquí.