library(tidyverse)
library(lubridate)
library(formattable)
library(wordcloud)
library(lattice)
library(igraph)
library(ggraph)
library(patchwork)
library(Rtsne)
library(ggrepel)
library(rtweet)
library(udpipe)
library(textrank)
library(syuzhet)
library(text2vec)

1 ANÁLISIS DE TWEETS

load("evaluacion.RData")

1.1 Tráfico de tweets (cuentas de museos El Prado, Reina Sofía y Thyssen)

Para analizar el tráfico de tweets de los tres museos, en primer lugar, juntamos los tweets de las tres cuentas en un mismo dataframe:

todos<-rbind(prado, reinasofia,thyssen)

# Por comodidad y estética creamos la variable museo con el nombre de los tres museos
todos<-todos %>% mutate(museo=case_when(screen_name=="museodelprado"~"Prado",
                                              screen_name=="museoreinasofia"~"Reina Sofía",
                                              screen_name=="MuseoThyssen"~"Thyssen"))

1.1.1 Por días

todos  %>% 
  filter(format(created_at, "%Y-%m-%d") <= "2020-04-01") %>% 
  group_by(museo) %>% 
  ts_plot() +
    scale_x_datetime(date_breaks = "1 months", labels = scales::date_format("%B")) +
    labs(title="Resumen de Tweets por días",subtitle = "Primer trimestre de 2020", x = NULL, y = "Tweets")

1.1.2 Por meses

# Gráfico de barras
p1<-todos %>% 
    filter(format(created_at,"%Y-%m-%d")>="2020-02-01" & format(created_at,"%Y-%m-%d")<="2021-04-30") %>%
    mutate(año = format(created_at, "%y"), mes = format(created_at, "%m")) %>%
    group_by(museo,año, mes) %>%
    summarize(total = n(), .groups = "drop") %>% 
  
    ggplot(aes(x=paste(año,mes,sep="-"), y=total,fill=museo)) + 
      geom_col(position = "dodge") +
      theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
      labs(x = NULL, y = "Tweets")

# Gráfico de barras apiladas
p2<-todos %>% 
    filter(format(created_at,"%Y-%m-%d")>="2020-02-01" & format(created_at,"%Y-%m-%d")<="2021-04-30") %>%     mutate(año = format(created_at, "%y"), mes = format(created_at, "%m")) %>%
    group_by(museo,año, mes) %>%
    summarize(total = n(), .groups = "drop") %>% 
  
    ggplot(aes(x=paste(año,mes,sep="-"), y=total,fill=museo)) + 
      geom_col(position = "stack") +
      theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
      labs(x = NULL, y = "Tweets")

# Ensamblado de gráficos
p1/p2+ 
  plot_annotation(title = "Resumen de Tweets por meses",
                  subtitle = "Periodo 01-02-2020 a 30-04-2021") +
  plot_layout(guides="collect")

En general, El Prado es el museo con un mayor tráfico de tweets en este periodo. El mes con menor tráfico de tweets es agosto de 2020 y con mayor tráfico marzo y noviembre de 2020. También se observa una disminución del tráfico en los meses de 2021 respecto los mismos meses del año anterior.

1.1.3 Por día de la semana

# Gráfico de barras
p3<-todos %>% 
    filter(format(created_at,"%Y-%m-%d")>="2020-02-01" & format(created_at,"%Y-%m-%d")<="2021-04-30") %>%
    group_by(museo,dia = wday(created_at, label = TRUE, abbr = FALSE,
            week_start = getOption("lubridate.week.start", 1))) %>%
    summarize(total = n(),.groups = "drop") %>% 
  
    ggplot(aes(x=dia, y=total, fill=museo)) + 
      geom_col(position = "dodge") +
      labs(x = NULL, y = "Tweets") +
      theme(axis.text.x = element_text(angle = 90, vjust=0.3))

# Gráfico de barras apiladas
p4<-todos %>% 
    filter(format(created_at,"%Y-%m-%d")>="2020-02-01" & format(created_at,"%Y-%m-%d")<="2021-04-30") %>%
    group_by(museo,dia = wday(created_at, label = TRUE, abbr = FALSE,
            week_start = getOption("lubridate.week.start", 1))) %>%
    summarize(total = n(),.groups="drop") %>% 
  
    ggplot(aes(x=dia, y=total, fill=museo)) + 
      geom_col(position = "stack") +
      labs(x = NULL, y = "Tweets") +
      theme(axis.text.x = element_text(angle = 90, vjust=0.3))

# Ensamblado de gráficos
p3+p4+ 
  plot_annotation(title = "Resumen de Tweets por día de la semana",
                      subtitle = "Periodo 01-02-2020 a 30-04-2021") +
  plot_layout(guides="collect")

Como era de esperar, sábados y domingos son los días con menor tráfico. Entre semana los días son similares.

1.1.4 Por hora

# Gráfico de barras
p5<-todos %>% 
      group_by(museo,hora = as.factor(hour(created_at))) %>% 
      summarize(total = n(), .groups = "drop") %>% 

    ggplot(aes(x=hora, y=total, fill=museo)) + 
      geom_col(position = "dodge") +
      labs(x = NULL, y = "Tweets")

# Gráfico de barras apiladas
p6<-todos %>% 
      group_by(museo,hora = as.factor(hour(created_at))) %>% 
      summarize(total = n(), .groups = "drop") %>% 

    ggplot(aes(x=hora, y=total, fill=museo)) + 
      geom_col(position = "stack") +
      labs(x = NULL, y = "Tweets")

# Ensamblado de gráficos
p5/p6+
  plot_annotation(title = "Resumen de Tweets por hora",
                  subtitle = "Periodo 01-02-2020 a 30-04-2021") +
  plot_layout(guides="collect")

En horario de mañana hay un mayor tráfico de tweets que en horario de tarde y, obviamente, que en horario nocturno.

1.2 Tweets, retweets y respuestas (cuenta Museo del Prado)

Creamos la variable tipo que nos indica si se trata de un tweet, un retweet o una respuesta:

# Creamos la variable tipo que nos indica si se trata de un tweet, un retweet o una respuesta.
prado$tipo <- "Tweet"
prado<-prado %>% mutate(tipo=as.factor( case_when(is_retweet ~ "Retweet",
                                                  !is.na(reply_to_status_id) ~ "Respuesta",
                                                  TRUE ~ tipo      )))

1.2.1 Por días

prado %>% 
  filter(format(created_at, "%Y-%m-%d") >= "2021-04-01" &
                format(created_at, "%Y-%m-%d") < "2021-07-01") %>%
  group_by(tipo) %>%
 ts_plot() + theme(legend.title=element_blank()) +
 scale_x_datetime(date_breaks = "1 months", labels = scales::date_format("%B")) +
 labs(title="Tweets, Retweets y Respuestas", subtitle = "Segundo trimestre de 2021", 
      x = NULL, y = "Frecuencia")

Hay un pico importante de retweets a principios de la segunda quincena mayo de 2021 y uno de respuestas en la primera quincena de junio de ese mismo año.

1.2.2 Por meses

# Gráfico de barras
p7<-prado %>% 
    filter(format(created_at,"%Y-%m-%d")>="2020-02-01" & format(created_at,"%Y-%m-%d")<="2021-04-30") %>%
    mutate(año = format(created_at, "%y"), mes = format(created_at, "%m")) %>%
    group_by(tipo,año, mes) %>%
    summarize(total = n(), .groups = "drop") %>% 
  
    ggplot(aes(x=paste(año,mes,sep="-"), y=total,fill=tipo)) + 
      geom_col(position = "dodge") +
      theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
      labs(x = NULL, y = "Tweets")

# Gráfico de barras apiladas
p8<-prado %>% 
    filter(format(created_at,"%Y-%m-%d")>="2020-02-01" & format(created_at,"%Y-%m-%d")<="2021-04-30") %>%     mutate(año = format(created_at, "%y"), mes = format(created_at, "%m")) %>%
    group_by(tipo,año, mes) %>%
    summarize(total = n(), .groups = "drop") %>% 
  
    ggplot(aes(x=paste(año,mes,sep="-"), y=total,fill=tipo)) + 
      geom_col(position = "stack") +
      theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
      labs(x = NULL, y = "Tweets")

# Ensamblado de gráficos
p7/p8+ 
  plot_annotation(title = "Resumen de Tweets, retweets y respuestas por meses",
                  subtitle = "Periodo 01-02-2020 a 30-04-2021") +
  plot_layout(guides="collect")

1.3 Tweets más retuiteados

A continuación, mostramos los 5 tweets (sin contar retweets) más retuiteados:

mas_retuiteados<-prado  %>% 
            filter(!is_retweet & retweet_count > 0 & year(created_at)==2020) %>%
            select(text, retweet_count, created_at) %>%
            arrange(desc(retweet_count))
            
head(mas_retuiteados,5) %>% 
  knitr::kable("html") %>%
  kableExtra::kable_styling("striped", full_width = F, font_size = 12)
text retweet_count created_at
Museo del Prado y Flamenco se juntan por el Día Mundial del Turismo, en defensa de la cultura como vínculo que une y supera las fronteras. Con la colaboración de la Asociación de Tablaos Flamencos de Madrid #Reencuentro https://t.co/KsdUMyD1uq 2897 2020-09-27 08:36:25
Con motivo del 2 de mayo, el Museo del Prado en colaboración con @Sheila_Blanco_, propone una visita online por la colección de Francisco de Goya #PradoContigo https://t.co/CY456wAL0T 1992 2020-05-02 08:38:23
The Museo del Prado and Flamenco get together for International Tourism Day supporting culture as a bond that unites and overcomes frontiers. In collaboration with the Asociación de Tablaos Flamencos de Madrid #Reencuentro https://t.co/wXyqISSeiR 1347 2020-09-27 10:21:46
El 19 de noviembre de 1819 abría sus puertas por primera vez el Museo del Prado. Hoy cumplimos 201 años y queremos agradeceros especialmente vuestro cariño #VuelvealPrado https://t.co/pixLNN6gD5 1222 2020-11-19 08:55:24
La sala del Bosco, que llevaba cerrada desde el 12 de marzo, vuelve a abrir con un nuevo montaje #VuelvealPrado https://t.co/QHoeNN1Chk 1155 2020-10-27 11:15:21

1.4 Usuarios más mencionados

Nube de palabras de usuarios más mencionados (sin incluir retweets):

usuarios <- prado %>% filter(!is.na(mentions_screen_name) & year(created_at)==2020 & !is_retweet) %>%
              select(mentions_screen_name)
usuarios <- unlist(usuarios)
usuarios <- table(usuarios)

# Filtramos aquellos usuarios que hayan sido mencionados al menos 4 veces
wordcloud(words=paste0("@",names(usuarios)), freq=usuarios, min.freq= 4, scale=c(2,.5), 
          random.order=F, colors=brewer.pal(8, "Dark2"))

Lo representamos ahora mediante un gráfico de barras para ver la frecuencia:

usuarios <- data.frame(usuarios)
colnames(usuarios) <- c("usuario", "frecuencia")
usuarios$usuario <- paste0("@", usuarios$usuario)

# Filtramos aquellos usuarios que hayan sido mencionados al menos 4 veces
ggplot(subset(usuarios, frecuencia > 3), aes(x=reorder(usuario, frecuencia), y=frecuencia,fill=frecuencia)) +
 geom_bar(stat="identity") +
 geom_text(aes(label=frecuencia), hjust=1.2, color="white", size=4) +
  theme_minimal()+
  theme(axis.text.y = element_text(size = 9,face = "bold"))+
  theme(legend.position="none")+
  labs(title = "Usuarios más mencionados",x="Usuarios", y="Frecuencia") + coord_flip()

1.5 Hastags más populares

Nube de palabras de los hashtags más utilizados (sin incluir retweets):

hashtags <- prado %>% filter(!is.na(hashtags) & year(created_at)==2020 & !is_retweet) %>%  
              select (hashtags)
hashtags <- unlist(hashtags)
hashtags <- table(hashtags)

# Filtramos los hashtags en quellos que aparecen al menos 2 veces
wordcloud(words=paste0("#",names(hashtags)), freq=hashtags, min.freq=2, scale=c(3,.5), random.order=F,
          colors=brewer.pal(8, "Dark2"))

Gráfico de barras para ver sus frecuencias:

hashtags <- data.frame(hashtags)
colnames(hashtags) <- c("hashtag", "frecuencia")
hashtags$hashtag <- paste0("#", hashtags$hashtag)

# Filtramos los hashtags en quellos que aparecen al menos 5 veces
ggplot(subset(hashtags, frecuencia > 4), aes(x=reorder(hashtag, frecuencia), y=frecuencia, fill=frecuencia)) +
 geom_bar(stat="identity") +
 geom_text(aes(label=frecuencia), hjust=1.2, color="white", size=3.5) +
  theme(axis.text.y = element_text(size = 9,face = "bold"))+
  theme(legend.position="none")+
  labs(title = "Hashtags más utilizados",x="Usuarios", y="Frecuencia") + coord_flip()

1.6 Usuarios a los que más responde

respuestas<-prado %>%
              filter(!is.na(reply_to_screen_name) & 
                       reply_to_screen_name !="museodelprado" &year(created_at)==2020) %>%
              group_by(cuenta=reply_to_screen_name) %>% 
              summarize(n = n(), .groups = "drop") %>% 
              arrange(n)
respuestas$cuenta<-factor(respuestas$cuenta,levels = respuestas$cuenta)

Gráfico de nube de puntos:

# Filtramos aquellos usuarios que hayan sido mencionados al menos 2 veces
wordcloud(words=paste0("@",respuestas$cuenta), freq=respuestas$n, min.freq= 2,
          scale=c(2,.5),random.order=F, colors=brewer.pal(8, "Dark2"))

Gráfico de barras:

respuestas$cuenta <- paste0("@", respuestas$cuenta)

# Filtramos aquellos usuarios que hayan sido mencionados al menos 5 veces
ggplot(subset(respuestas, n > 2), aes(x=reorder(cuenta, n), y=n,fill=n)) +
  geom_bar(stat="identity") +
  geom_text(aes(label=n), hjust=1.2, color="white", size=3) +
  theme_minimal()+
  theme(axis.text.y = element_text(size = 8,face = "bold"))+
  theme(legend.position="none")+
  labs(title = "Cuentas a las que El Prado más responde",x="Cuentas", y="Frecuencia") + 
  coord_flip()

1.7 Usuarios a los que más retuitea

usuarios_retuiteados <-subset(prado,is_retweet & year(created_at)==2020,select=mentions_screen_name) %>%
  unlist()
usuarios_retuiteados <-data.frame(usuario=usuarios_retuiteados) %>% filter(usuario!="museodelprado") %>%
  group_by(usuario) %>% count() %>% arrange(-n)

Gráfico de nube de palabras:

# Filtramos aquellos usuarios que hayan sido mencionados al menos 3 veces
wordcloud(words=paste0("@",usuarios_retuiteados$usuario), freq=usuarios_retuiteados$n, min.freq= 3,
          scale=c(2,.5),random.order=F, colors=brewer.pal(8, "Dark2"))

Gráfico de barras:

usuarios_retuiteados$usuario <- paste0("@", usuarios_retuiteados$usuario)

# Filtramos aquellos usuarios que hayan sido mencionados al menos 5 veces
ggplot(subset(usuarios_retuiteados, n > 4), aes(x=reorder(usuario, n), y=n,fill=n)) +
  geom_bar(stat="identity") +
  geom_text(aes(label=n), hjust=1.2, color="white", size=3) +
  theme_minimal()+
  theme(axis.text.y = element_text(size = 8,face = "bold"))+
  theme(legend.position="none")+
  labs(title = "Cuentas a las que El Prado más retuitea",x="Cuentas", y="Frecuencia") + 
  coord_flip()

1.8 Tweets con más “me gusta”

Se muestran los 5 tweets (sin incluir retweets) con un mayor número de favoritos (me gusta):

mas_mg<-prado %>% filter(year(created_at)==2020 & !is_retweet) %>% arrange(-favorite_count) %>%
          select(text,favorite_count,created_at)

head(mas_mg) %>% 
  knitr::kable("html") %>%
  kableExtra::kable_styling("striped", full_width = F, font_size = 12)
text favorite_count created_at
Museo del Prado y Flamenco se juntan por el Día Mundial del Turismo, en defensa de la cultura como vínculo que une y supera las fronteras. Con la colaboración de la Asociación de Tablaos Flamencos de Madrid #Reencuentro https://t.co/KsdUMyD1uq 6681 2020-09-27 08:36:25
Con motivo del 2 de mayo, el Museo del Prado en colaboración con @Sheila_Blanco_, propone una visita online por la colección de Francisco de Goya #PradoContigo https://t.co/CY456wAL0T 5025 2020-05-02 08:38:23
Los tesoros del taller de restauración del Museo del Prado https://t.co/nHuZCaQzpU 4516 2020-09-23 16:21:00
El 19 de noviembre de 1819 abría sus puertas por primera vez el Museo del Prado. Hoy cumplimos 201 años y queremos agradeceros especialmente vuestro cariño #VuelvealPrado https://t.co/pixLNN6gD5 3615 2020-11-19 08:55:24
La sala del Bosco, que llevaba cerrada desde el 12 de marzo, vuelve a abrir con un nuevo montaje #VuelvealPrado https://t.co/QHoeNN1Chk 3386 2020-10-27 11:15:21
¡Feliz #DíaInternacionaldelFlamenco! https://t.co/VJO0PDUprB 3158 2020-11-16 11:23:17

1.9 Plataformas más utilizadas para escribir tweets

plataformas <- prado %>% 
                filter(year(created_at)==2020) %>% 
                group_by(source) %>% 
                summarize(n = n(), .groups = "drop") %>%
                mutate(porcentaje = n/sum(n)) %>%
                arrange(n)
plataformas$source <- factor(plataformas$source, levels = plataformas$source)
ggplot(plataformas, aes(x=source, y=n, fill=source)) +
 geom_bar(stat = "identity", color="grey30") +
 geom_text(aes(label=paste0(round(porcentaje*100,2),"%")), hjust=-0.05, vjust=0.3, size=3) +
 scale_fill_brewer(palette="Paired") + coord_flip() +
 theme_minimal() + theme(legend.position="none") +
 labs(title="Plataformas más usadas", x="Plataforma", y="Tweets")

1.10 Idiomas en los que están escritos los tweets

idiomas <- prado %>% 
              filter(year(created_at)==2020) %>% 
              group_by(lang) %>% 
              summarize(n = n(), .groups = "drop") %>%
              mutate(porcentaje = n/sum(n)) %>% arrange(desc(n))

idiomas$lang <- factor(idiomas$lang, levels = idiomas$lang)

ggplot(idiomas, aes(x=lang, y=n, fill=lang)) +
 geom_bar(stat = "identity", color="grey30") +
 geom_text(aes(label=paste0(round(porcentaje*100,2),"%")), vjust=-0.8, size=2.8) +
 scale_fill_brewer(palette="Paired") + theme_minimal() +
 theme(legend.title=element_blank(), axis.text.x=element_blank()) +
 labs(title="Idiomas más utilizados", x="Idiomas", y="Tweets")

2 TEXT MINING

Filtramos los tweets según las especificaciones del enunciado:

prado_filt<- prado %>%  
              filter(format(created_at,"%Y-%m-%d")>="2020-07-01" &
                       format(created_at,"%Y-%m-%d")<="2021-06-30") %>% # Del 01/07/2020 al 30/06/2021
              filter(lang=="es") %>%  # Sólo tweets en español
              filter(!is_retweet) %>% # Sin incluir retweets
              filter(is.na(reply_to_status_id)) #No incluir respuestas

Limpiamos el texto para realizar el análisis linguistico de una forma más cómoda:

prado_filt$textmining<-prado_filt$text

# Quitar "RT @usuario"
prado_filt$textmining <- gsub("RT @\\w+", "", prado_filt$textmining)

# Quitar "@usuario"
prado_filt$textmining <- gsub("@\\w+", "", prado_filt$textmining)

# Quitar "#hashtag"
prado_filt$textmining <- gsub("#\\w+", "", prado_filt$textmining)

# Quitar "URL"
prado_filt$textmining <- gsub("http[^[:blank:]]*", "", prado_filt$textmining)

# Añadir espacio después de "coma", "punto y coma", "dos puntos" (depurar si fuera necesario)
prado_filt$textmining <- gsub("(,|;|:)([[:alpha:]])", "\\1 \\2", prado_filt$textmining)

# Conservar letras, dígitos, espacios en blanco, saltos de línea y caracteres de puntuación
prado_filt$textmining <- gsub("[^[:alpha:][:digit:][:space:][:punct:]]*", "", prado_filt$textmining)

# Eliminar espacios en blanco sobrantes
prado_filt$textmining <- gsub("\\s{2,}", " ", prado_filt$textmining)

# Quitar espacios en blanco al inicio y final del texto
prado_filt$textmining <- trimws(prado_filt$textmining)

2.1 Análisis linguistico

Cargamos el modelo UDPipe:

model <- udpipe_load_model(file = "spanish-gsd-ud-2.5-191206.udpipe")

Realizamos la anotación del texto:

anot <- udpipe_annotate(model,x = prado_filt$textmining)
anot <- as.data.frame(anot)
anot$lemma <- tolower(anot$lemma)

En primer lugar, examinaremos los tokens cuya categoría gramatical (upos) esta etiquetada como “X”, que recoge aquellos términos que el modelo no es capaz de asociar con una categoría gramatical concreta:

terminos_raros<-anot %>% filter(upos=="X")
# Examinamos los que aparecen más de una vez
txt_freq(terminos_raros$lemma) %>% filter(freq>1) %>% arrange(-freq) %>% formattable()
key freq freq_pct
online 11 13.75
1833-1931 9 11.25
18:15 6 7.50
d 5 6.25
9b 5 6.25
17h 3 3.75
10.15h 3 3.75
12.15h 3 3.75
16.15h 3 3.75
etc. 3 3.75
60a 2 2.50
x 2 2.50

El término “online”, que aparece 11 veces, puede ser interesante incluirlo en el análisis, por lo que le cambiamos la categoría gramatical a adjetivo.

anot<-anot %>% mutate(upos=ifelse(lemma=="online","ADJ",upos))

2.2 Términos más frecuentes

# Sustantivos
terminos_n <- subset(anot, upos == "NOUN")
terminos_n <- txt_freq(terminos_n$lemma)
terminos_n$key <- factor(terminos_n$key, levels = rev(terminos_n$key))

barchart(key ~ freq, data = head(terminos_n, 20), col = "cadetblue",
         main = list("Sustantivos más frecuentes", cex="1"), xlab = "Frecuencia")

# Nombres propios
terminos_np <- subset(anot, upos == "PROPN")
terminos_np <- txt_freq(terminos_np$lemma)
terminos_np$key <- factor(terminos_np$key, levels = rev(terminos_np$key))

barchart(key ~ freq, data = head(terminos_np, 20), col = "cadetblue",
         main = list("Nombres propios más frecuentes", cex="1"), xlab = "Frecuencia")

#Adjetivos
terminos_a <- subset(anot, upos == "ADJ")
terminos_a <- txt_freq(terminos_a$lemma)
terminos_a$key <- factor(terminos_a$key, levels = rev(terminos_a$key))

barchart(key ~ freq, data = head(terminos_a, 20), col = "cadetblue",
         main = list("Adjetivos más frecuentes", cex="1"), xlab = "Frecuencia")

# Verbos
terminos_v <- subset(anot, upos == "VERB")
terminos_v <- txt_freq(terminos_v$lemma)
terminos_v$key <- factor(terminos_v$key, levels = rev(terminos_v$key))

barchart(key ~ freq, data = head(terminos_v, 20), col = "cadetblue",
         main = list("Verbos más frecuentes", cex="1"), xlab = "Frecuencia")

Respecto a los verbos, visita puede hacer referencia tanto a un verbo como a un sustantivo. En cualquier caso, si se trata de un verbo el lemma debería ser visitar y no visita. Examinamos este término:

subset(anot, lemma == "visita", select = c(token,lemma,upos,sentence))

Tras analizar las frases en las que aparece este término, comprobamos que está erróneamente etiquetado y realmente se trata de un sustantivo (normalmente acompañado de virtual o guiada), por lo que lo corregimos:

anot<-anot %>% mutate(upos=ifelse(lemma=="visita","NOUN",upos))

Lo mismo ocurre con invitado, que aparece tanto en verbo como en adjetivo. Lo examinamos:

subset(anot, lemma =="invitado", select = c(token,lemma,upos,sentence))

Comprobamos que realmente se trata del nombre de una exposición, “Invitadas”, por tanto, cambiamos la categoría a la de nombre propio.

anot<-anot %>% mutate(upos=ifelse(lemma=="invitado","PROPN",upos),
                      lemma=ifelse(lemma=="invitado","Invitadas",lemma))

2.3 Palabras clave

2.3.1 RAKE

kwrake <- keywords_rake(x = anot, term = "lemma", group = "doc_id", # Agrupamos por documento (tweet)
                    relevant = anot$upos %in% c("NOUN", "ADJ","PROPN")) # Sólo sustantivos, adjetivos y
                                                                        #  nombres propios
kwrake$key <- factor(kwrake$keyword, levels = rev(kwrake$keyword))

# Graficamos palabras clave que aparezcan al menos 5 veces
barchart(key ~ rake, data = head(subset(kwrake, freq > 4), 20), col = "cadetblue",
         main = list("Identificar palabras clave mediante RAKE", cex="1"), xlab = "RAKE")

2.3.2 PMI

kwpmi <- keywords_collocation(x = anot, term = "lemma", group = "doc_id")
kwpmi$key <- factor(kwpmi$keyword, levels = rev(kwpmi$keyword))

barchart(key ~ pmi, data = head(subset(kwpmi, freq > 9), 20), col = "cadetblue",
         main = list("Identificar palabras clave mediante Colocación PMI", cex="1"),
         xlab = "PMI (Pointwise Mutual Information)")

2.3.3 Extracción de frases

En primer lugar, obtendremos las frases nominales simples más frecuentes:

anot$phrase_tag <- as_phrasemachine(anot$upos, type = "upos")

# Cambiar etiqueta a "pronombres" y "números"
anot$phrase_tag[anot$upos=="PRON"] <- "O"
anot$phrase_tag[anot$upos=="NUM"] <- "O"

# Obtenemos las frases nominales simples (expresión regular)
kwphrases <- keywords_phrases(x = anot$phrase_tag, term = tolower(anot$token),
                              pattern = "(A|N)*N(P+D*(A|N)*N)*",
                              is_regex = TRUE, detailed = FALSE)

# Filtramos aquellas que contienen más de una palabra y aparecen más de 3 veces
kwphrases <- subset(kwphrases, ngram > 1 & freq > 3)
kwphrases$key <- factor(kwphrases$keyword, levels = rev(kwphrases$keyword))

barchart(key ~ freq, data = head(kwphrases, 20), col = "cadetblue",
         main = list("Palabras Clave - Frases nominales simples", cex="1"), xlab = "Frecuencia")

En segundo lugar, obtenemos las entidades formadas por dos nombres propios más frecuentes:

kwphrases <- keywords_phrases(x = anot$upos, term = tolower(anot$token),
                              pattern = c("PROPN", "PROPN"), detailed = FALSE)
kwphrases$key <- factor(kwphrases$keyword, levels = rev(kwphrases$keyword))
barchart(key ~ freq, data = head(kwphrases, 20), col = "cadetblue",
         main = list("Palabras Clave - Nombres Propios Compuestos", cex="1"), xlab = "Frecuencia")

2.3.4 TextRank

keywords <- textrank_keywords(anot$lemma, relevant = anot$upos %in% c("NOUN", "ADJ","PROPN"),
                              ngram_max = 8, sep = " ") # Sólo sustantivos, adjetivos y nombres propios

# Filtramos aquellas que contienen más de una palabra y aparecen más de 3 veces
keywords <- subset(keywords$keywords, ngram > 1 & freq > 3) 
keywords$keyword <- factor(keywords$keyword, levels = rev(keywords$keyword))

# Nube de palabras clave más frecuentes
wordcloud(words=keywords$keyword, freq=keywords$freq, random.order=F, colors=brewer.pal(8,"Dark2"))

# Gráfico de barras
barchart(keyword ~ freq, data = head(keywords, 20), col = "cadetblue",
         main = list("Palabras Clave - Nombres Propios Compuestos", cex="1"), xlab = "Frecuencia")

2.4 Coocurrencias

2.4.1 Por tweet y por oración

terminos <- subset(anot, upos %in% c("ADJ", "NOUN", "PROPN") & 
                     !lemma %in% c("museo","prado","museodelprado"))

# Qué palabras coocurren por tweet
cooc <- cooccurrence(terminos, group = "doc_id", term = "lemma")
head(data.frame(cooc)) %>% formattable()
term1 term2 cooc
canal youtube 38
facebook instagram 36
conferencia vídeo 34
exposición Invitadas 27
exposición mitológico 25
alejandro vergara 25 
# Qué palabras coocurren por tweet y oración
cooc <- cooccurrence(terminos, group = c("doc_id", "sentence_id"), term = "lemma")
head(data.frame(cooc)) %>% formattable()
term1 term2 cooc
canal youtube 37
facebook instagram 35
conferencia vídeo 34
exposición Invitadas 27
alejandro vergara 25
exposición mitológico 24 
wordnetwork <- graph_from_data_frame(head(cooc, 50))
ggraph(wordnetwork, layout = "fr") +
  geom_edge_link(aes(width = cooc, edge_alpha = cooc), edge_colour = "pink") +
  geom_node_text(aes(label = name), col = "darkgreen", size = 3.5) +
  theme_graph(base_family = "sans") + theme(legend.position = "none") +
  labs(title = "Coocurrencias tweet/oración", 
       subtitle = "Sustantivos, Adjetivos y Nombres Propios") +
  theme(plot.title = element_text(size = 14), plot.margin = margin(0,1,0,1))

Como los tweets suelen estar compuestos de una o pocas oraciones, las coocurrencias por tweets y las coocurrencias por oración son muy similares.

2.4.2 Palabras que se siguen

# Cuántas veces cada palabra es seguida por otra palabra
cooc <- cooccurrence(terminos$lemma)  # Por defecto: skipgram = 0
head(data.frame(cooc)) %>% formattable()
term1 term2 cooc
canal youtube 37
instagram facebook 33
vídeo conferencia 27
exposición Invitadas 26
alejandro vergara 25
echar vistazo 19

2.4.3 Palabras que están próximas

# Contando la siguiente y la que continúa a ésta (skipgram = 1)
cooc <- cooccurrence(terminos$lemma, skipgram = 1)
head(data.frame(cooc)) %>% formattable()
term1 term2 cooc
canal youtube 37
instagram facebook 33
vídeo conferencia 28
exposición Invitadas 26
alejandro vergara 25
vistazo vídeo 20 
# skipgram = 2
cooc2 <- cooccurrence(terminos$lemma, skipgram = 2)
head(data.frame(cooc2)) %>% formattable()
term1 term2 cooc
canal youtube 37
instagram facebook 33
vídeo conferencia 31
exposición Invitadas 26
alejandro vergara 25
información web 20 
# Graficamos coocurrencias con skipgram = 1
wordnetwork <- graph_from_data_frame(head(cooc, 50))
ggraph(wordnetwork, layout = "fr") +
  geom_edge_link(aes(width = cooc, edge_alpha = cooc),edge_colour = "pink") +
  geom_node_text(aes(label = name), col = "darkgreen", size = 3.5) +
  theme_graph(base_family = "sans") +
  labs(title = "Qué palabras están próximas", subtitle = "Sustantivos, Adjetivos y Nombres Propios") +
  theme(plot.title = element_text(size = 14), plot.margin = margin(0,1,0,1))

2.5 Correlaciones

Para calcular las correlaciones hay que obtener primero la matriz documento-término:

# Identificador único de cada oración del corpus
anot$id <- unique_identifier(anot, fields = c("doc_id", "sentence_id"))

# Seleccionamos sólo sustantivos, adjetivos y nombres propios
dtf <- subset(anot, upos %in% c("NOUN", "ADJ", "PROPN"))

# Creamos matriz documento-término
dtf <- document_term_frequencies(dtf, document = "id", term = "lemma")
dtm <- document_term_matrix(dtf)

# Eliminamos términos que aparezcan menos de 10 veces
dtm <- dtm_remove_lowfreq(dtm, minfreq = 10)

# Eliminamos algunas palabras que no aportan nada al análisis
dtm <- dtm_remove_terms(dtm, terms = c("museo", "prado","museodelprado"))

Ahora calculamos las correlaciones a partir de la matriz documento-término:

termcorr <- dtm_cor(dtm)
dim(termcorr)
## [1] 122 122

A modo de ejemplo, se muestran las correlaciones entre los 10 primeros términos:

as.data.frame(round(termcorr[1:10,1:10],2)) %>% formattable()
actividad alejandro allori amigo anunciación año arte artista artístico beca
actividad 1.00 -0.03 -0.02 -0.02 -0.02 0.04 -0.01 -0.03 -0.02 -0.02
alejandro -0.03 1.00 0.11 -0.02 -0.02 -0.04 -0.04 -0.03 -0.03 -0.02
allori -0.02 0.11 1.00 -0.01 -0.01 -0.02 -0.03 -0.02 -0.02 -0.01
amigo -0.02 -0.02 -0.01 1.00 -0.01 -0.02 0.20 -0.02 -0.02 -0.01
anunciación -0.02 -0.02 -0.01 -0.01 1.00 -0.02 -0.03 -0.02 0.24 -0.01
año 0.04 -0.04 -0.02 -0.02 -0.02 1.00 -0.05 0.01 -0.03 -0.02
arte -0.01 -0.04 -0.03 0.20 -0.03 -0.05 1.00 -0.04 0.09 -0.03
artista -0.03 -0.03 -0.02 -0.02 -0.02 0.01 -0.04 1.00 -0.02 0.06
artístico -0.02 -0.03 -0.02 -0.02 0.24 -0.03 0.09 -0.02 1.00 -0.02
beca -0.02 -0.02 -0.01 -0.01 -0.01 -0.02 -0.03 0.06 -0.02 1.00

2.6 Extracción de temas

2.6.1 Nombres de pintores y exposiciones

Analizando las concurrencias y las palabras clave podemos identificar las exposiciones “Invitadas” y “Pasiones Mitológicas” y los artistas Alejandro Vergara, Miguel Falomir, Carmen Sánchez y Van Dyck.

2.6.2 “Pasiones Mitológicas”

Identificamos aquellos tweets que contienen alguna de las cadenas referidas en el código relativas a la exposición “Pasiones Mitológicas”:

pasiones_mit<-prado %>% filter(str_detect(tolower(text),c("pasiones mitológicas","pasiones mitologicas",
                                                    "#pasionesmitológicas","#pasionesmitologicas"))) %>% 
            arrange(created_at)
## Warning in stri_detect_regex(string, pattern, negate = negate, opts_regex =
## opts(pattern)): longer object length is not a multiple of shorter object length
nrow(pasiones_mit)
## [1] 19

Identificamos 19 tweets que contienen esas cadenas.
Imprimimos los 5 más antiguos:

head(pasiones_mit,5) %>% 
  select(text,created_at) %>% 
  knitr::kable("html") %>%
  kableExtra::kable_styling("striped", full_width = F, font_size = 12)
text created_at
#PublicacionesPrado “Pasiones mitológicas: Tiziano, Veronese, Allori, Rubens, Ribera, Poussin, Van Dyck, Velázquez”, el catálogo de la exposición. Textos de Miguel Falomir, Sheila Barker, Javier Moscoso y Alejandro Vergara https://t.co/An7wkei7mb https://t.co/bZxuPBplbm 2021-03-01 14:11:24
Hoy a las 20h inauguramos la exposición #PasionesMitológicas en directo con sus comisarios, Miguel Falomir y Alejandro Vergara. Podréis seguir el recorrido por Instagram, Facebook o TikTok https://t.co/2MCGpLe1Hf https://t.co/InSgiB0L28 2021-03-01 16:36:00
El @museodelprado presenta ‘Pasiones mitológicas: Tiziano, Veronese, Allori, Rubens, Ribera, Poussin, Van Dyck, Velázquez’, expo que reúne por primera vez las 6 obras basadas en la poesía clásica griega pintadas por Tiziano para Felipe II (1553-1562). https://t.co/aiXT7biA1o https://t.co/rutn7RSPzX 2021-03-02 09:17:22
@Anitatotallook Ana, gracias por asistir a la inauguración de “Pasiones mitológicas”. Esperamos que puedas venir a verla pronto al Museo 2021-03-02 09:54:53
El @museodelprado ofrece la oportunidad de contemplar la exposición ‘Pasiones mitológicas’ patrocinada por la @FundacionBBVA. Una de las mejores selecciones de la pintura mitológica que se hizo en Europa en los siglos XVI y XVII. <U+0001F44F> https://t.co/zaiL1XueWO 2021-03-03 10:02:07

Para obtener las coocurrencias, vamos a anotar el texto de los tweets anteriores y, tras ello, escogeremos sólo sustantivos, adjetivos y nombres propios (a excepción de “museo”,“prado” y “museodelprado”):

pasiones_mit$textmining<-pasiones_mit$text
anot_pasiones <- udpipe_annotate(model,x = pasiones_mit$textmining)
anot_pasiones <- as.data.frame(anot_pasiones)
anot_pasiones$lemma <- tolower(anot_pasiones$lemma)

terminos <- subset(anot_pasiones, upos %in% c("ADJ", "NOUN", "PROPN") & 
                     !lemma %in% c("museo","prado","museodelprado"))

Obtenemos las coocurrencias por tweet y mostramos las 6 mayores:

# Qué palabras coocurren por tweet
cooc <- cooccurrence(terminos, group = "doc_id", term = "lemma")
cooc<-data.frame(cooc)
head(filter(cooc,term1== "pasionesmitológicas" & cooc>1)) %>% formattable()
term1 term2 cooc
pasionesmitológicas pintura 5
pasionesmitológicas siglo 4
pasionesmitológicas pradoeducación 3
pasionesmitológicas tiziano 3
pasionesmitológicas virtual 3
pasionesmitológicas vergara 2

2.6.3 “Invitadas”

Repetimos exactamente el mismo proceso anterior para la exposición “Invitadas”.

invitadas<-prado %>% filter(str_detect(tolower(text),c("invitadas","#invitadas"))) %>% 
                    arrange(created_at)
## Warning in stri_detect_regex(string, pattern, negate = negate, opts_regex =
## opts(pattern)): longer object length is not a multiple of shorter object length
head(invitadas,5) %>% 
  select(text,created_at) %>% 
  knitr::kable("html") %>%
  kableExtra::kable_styling("striped", full_width = F, font_size = 12)
text created_at

<U+0001F5BC><U+FE0F> “Nuevos públicos, nuevas narrativas” es el lema que guiará al @museodelprado en 2020.

<U+0001F538>La mujer en la pintura: ‘Invitadas’

<U+0001F538>Una muestra dedicada a las obras que llegaron a España desde América

<U+0001F517>https://t.co/fTK3zsoabo https://t.co/79127P4CV4 		2020-01-10 20:33:37
#Congreso “Un siglo de estrellas fugaces”. El lugar de las mujeres en el Sistema de Arte español en el siglo XIX: cuestiones sobre ideología, escenarios y carreras profesionales. Envío de propuestas de comunicaciones: hasta el 8 de marzo https://t.co/RvPegyMR5v #LasInvitadas https://t.co/mLCaI4pkqV 2020-01-20 11:36:00

El 31 de marzo se inaugura la exposición “Invitadas. Fragmentos sobre mujeres, ideología y artes plásticas en España (1833-1931)”.

Exposición sobre el papel de la mujer en el sistema español de arte en el siglo XIX y principios del XX. Más información en: https://t.co/mQIbyR57Ik https://t.co/LlZyd12Kzf 		2020-02-26 12:06:22
Miguel Falomir, director del Museo del Prado, habla sobre la exposición “Invitadas. Fragmentos sobre mujeres, ideología y artes plásticas en España (1833-1931)” que se iba a inaugurar hoy https://t.co/1VqbWBEIJV #PradoContigo https://t.co/oznXKqV4pW 2020-03-30 10:37:47

Mujeres, invitadas de la Historia del Arte es la exposición que @museodelprado tenía lista cuando se decretó el estado de alarma.

@EfectoDopplerR3 ha hablado con su comisario @CarlosG_Navarro https://t.co/8r2JibUNOP https://t.co/5wizlczr4v 		2020-05-13 11:34:18 
invitadas$textmining<-invitadas$text
anot_invitadas <- udpipe_annotate(model,x = invitadas$textmining)
anot_invitadas <- as.data.frame(anot_invitadas)
anot_invitadas$lemma <- tolower(anot_invitadas$lemma)

terminos <- subset(anot_invitadas, upos %in% c("ADJ", "NOUN", "PROPN") & 
                     !lemma %in% c("museo","prado","museodelprado"))

# Qué palabras coocurren por tweet
cooc <- cooccurrence(terminos, group = "doc_id", term = "lemma")
cooc<-data.frame(cooc)
head(filter(cooc,term1=="invitado" & cooc>1),10) %>% formattable()
term1 term2 cooc
invitado mujer 19
invitado plástico 8
invitado pradoeducación 8
invitado obra 6
invitado siglo 6
invitado sistema 5
invitado papel 4
invitado prensa 4
invitado rueda 4
invitado web 4

2.7 Word embeddings

2.7.1 Modelo GloVe

Antes de crear el modelo GloVe es necesario preparar el texto. Para ello, es necesario lematizarlo, seleccionando sólo sustantivos,adjetivos y nombres propios:

terminos <- subset(anot, upos %in% c("NOUN", "ADJ", "PROPN"), select = c("doc_id", "lemma"))
terminos <- split(terminos$lemma, terminos$doc_id)
terminos <- lapply(terminos, paste, collapse = " ")
docs <- do.call(rbind.data.frame, c(terminos, stringsAsFactors=FALSE))
colnames(docs) <- "texto"
docs$id <- as.numeric(str_sub(names(terminos),start = 4))
docs <- docs[order(docs$id), c("id", "texto")]
row.names(docs) <- NULL
rm(terminos)

Creamos los tokens del texto:

tokens <- space_tokenizer(docs$texto)

Creamos el vocabulario:

# Crear iterador
it <- itoken(tokens, progressbar = FALSE)

# Crear el vocabulario
vocab <- create_vocabulary(it)
vocab <- vocab[order(vocab$term_count, decreasing = T),]
vocab$doc_porc <- vocab$doc_count/length(docs$texto)  # Porcentaje

# Filtramos los términos del vocabulario en aquellos que aparecen al menos 7 veces y que no aparezcan 
# en más del 50% de los documentos (tweets)
vocab <- prune_vocabulary(vocab, term_count_min = 7, doc_proportion_max = 0.5)

Definimos la función de vectorización y creamos la matriz de coocurrencias de términos, considerando una ventana de 5 términos:

# Definir la función de vectorización
vectorizer <- vocab_vectorizer(vocab)

# Construir la matriz de coocurrencia de términos
tcm <- create_tcm(it, vectorizer, skip_grams_window = 5)

Creamos el modelo GloVe con vectores de palabras de 20 dimensiones y un número máximo de coocurrencias para usar en la función de pesado de 10:

glove <- GlobalVectors$new(rank = 20, x_max = 10)

Ajustamos el modelo con 50 iteraciones y un criterio de convergencia de 0,005:

wv_main <- glove$fit_transform(tcm, n_iter = 50, convergence_tol = 0.005)
dim(wv_main)
## [1] 202  20

Obtenemos los vectores de palabras de “contexto”:

wv_context <- glove$components
dim(wv_context)
## [1]  20 202

Unimos los vectores de palabras principales y de palabras de contexto:

word_vectors <- wv_main + t(wv_context)

2.7.2 Similitudes de los términos: “exposición”, “anunciación”, “mujer” y “calisto”.

Una vez tenemos construido el modelo, podemos ver con que términos guarda relación o similitud una determinada palabra y en qué medida. Lo comprobamos con las palabras “exposición”, “anunciación”, “mujer” y “calisto”:

# vector("exposición")
wv <- word_vectors["exposición", ,drop = FALSE]
# Palabras relacionadas con "exposición"
cos_sim <- sim2(x = word_vectors, y = wv, method = "cosine", norm = "l2")
head(sort(cos_sim[,1], decreasing = TRUE), 5)
##    exposición      temporal       virtual documentación  especialista 
##     1.0000000     0.6616350     0.5898764     0.5554472     0.5525992
# vector("anunciación")
wv <- word_vectors["anunciación", ,drop = FALSE]
# Palabras relacionadas con "anunciación"
cos_sim <- sim2(x = word_vectors, y = wv, method = "cosine", norm = "l2")
head(sort(cos_sim[,1], decreasing = TRUE), 5)
## anunciación         fra    angelico       ciclo      visita 
##   1.0000000   0.8158403   0.6627933   0.5601715   0.5166646
# vector("mujer")
wv <- word_vectors["mujer", ,drop = FALSE]
# Palabras relacionadas con "mujer"
cos_sim <- sim2(x = word_vectors, y = wv, method = "cosine", norm = "l2")
head(sort(cos_sim[,1], decreasing = TRUE), 5)
##     mujer ideología fragmento  flamenca      jefe 
## 1.0000000 0.7419260 0.6788296 0.5963422 0.5503811
# vector("calisto")
wv <- word_vectors["calisto", ,drop = FALSE]
# Palabras relacionadas con "calisto"
cos_sim <- sim2(x = word_vectors, y = wv, method = "cosine", norm = "l2")
head(sort(cos_sim[,1], decreasing = TRUE), 5)
##   calisto    ribera   tiziano  veronese    allori 
## 1.0000000 0.7101398 0.6814566 0.6421801 0.5946894

2.7.3 Visualización de word embeddings mediante t‐SNE

Creamos un modelo t-SNE con un nivel de perplejidad de 20 y un máximo de iteraciones de 2000:

tsne <- Rtsne(word_vectors, dims = 2, perplexity = 20,max_iter = 2000)
tsne_plot <- data.frame(x = tsne$Y[,1], y = tsne$Y[,2], palabra = rownames(word_vectors))
ggplot(tsne_plot, aes(x,y)) +
  geom_text_repel(aes(label=palabra), size = 2.8, box.padding = 0.1) +
  labs(title = "Modelo GloVe (t-SNE)", x = "X", y = "Y")

3 ANÁLISIS DE SENTIMIENTOS

En primer lugar, eliminamos los retweets, las respuestas y los que no estén escritos en español (puesto que vamos a utilizar un lexicon en español)

lavecinarubia_filt<- lavecinarubia %>% 
              filter(lang=="es") %>%  # Sólo tweets en español
              filter(!is_retweet) %>% # Sin incluir retweets
              filter(is.na(reply_to_status_id)) #No incluir respuestas

Limpiamos el texto:

lavecinarubia_filt$textmining<-lavecinarubia_filt$text

# Quitar "RT @usuario"
lavecinarubia_filt$textmining <- gsub("RT @\\w+", "", lavecinarubia_filt$textmining)

# Quitar "@usuario"
lavecinarubia_filt$textmining <- gsub("@\\w+", "", lavecinarubia_filt$textmining)

# Quitar "#hashtag"
lavecinarubia_filt$textmining <- gsub("#\\w+", "", lavecinarubia_filt$textmining)

# Quitar "URL"
lavecinarubia_filt$textmining <- gsub("http[^[:blank:]]*", "", lavecinarubia_filt$textmining)

# Añadir espacio después de "coma", "punto y coma", "dos puntos" (depurar si fuera necesario)
lavecinarubia_filt$textmining <- gsub("(,|;|:)([[:alpha:]])", "\\1 \\2", 
                                      lavecinarubia_filt$textmining)

# Conservar letras, dígitos, espacios en blanco, saltos de línea y caracteres de puntuación
lavecinarubia_filt$textmining <- gsub("[^[:alpha:][:digit:][:space:][:punct:]]*", "", lavecinarubia_filt$textmining)

# Eliminar espacios en blanco sobrantes
lavecinarubia_filt$textmining <- gsub("\\s{2,}", " ", lavecinarubia_filt$textmining)

# Quitar espacios en blanco al inicio y final del texto
lavecinarubia_filt$textmining <- trimws(lavecinarubia_filt$textmining)

3.1 Análisis linguistico

Anotamos el texto con UDPipe:

anot2 <- udpipe_annotate(model,x = lavecinarubia_filt$textmining)
anot2 <- as.data.frame(anot2)
anot2$lemma <- tolower(anot2$lemma)

Obtenemos el texto lematizado de cada tweet:

terminos <- subset(anot2, !is.na(lemma), select = c("doc_id", "lemma")) # Eliminamos los lemmas
                                                                        # con valor NA
terminos <- split(terminos$lemma, terminos$doc_id)
terminos <- lapply(terminos, paste, collapse = " ")
docs <- do.call(rbind.data.frame, c(terminos, stringsAsFactors=FALSE))
colnames(docs) <- "texto"
docs$id <- as.numeric(str_sub(names(terminos),start = 4))
docs <- docs[order(docs$id,decreasing = TRUE), c("id", "texto")]# Decreasing=TRUE para ordenar los 
                                                                # tweets de más antiguo a más reciente
row.names(docs) <- NULL
rm(terminos)

3.2 Obtención de sentimientos con get_sentiment. Gráfico de trayectoria emocional

Obtenemos el nivel de sentimiento de cada tweet:

sentimientos <- get_sentiment(docs$texto, method = "nrc", language = "spanish")
summary(sentimientos)
##     Min.  1st Qu.   Median     Mean  3rd Qu.     Max. 
## -13.0000   0.0000   0.0000   0.4124   1.0000   7.0000

Graficamos la trayectoria emocional en el tiempo:

sentimientosdf <- data.frame(sentimientos)
sentimientosdf$fecha <- sort(lavecinarubia_filt$created_at) # Ordenado de más antiguo a más reciente
                                                            # para que concuerde

ggplot(sentimientosdf, aes(x=fecha, y=sentimientos)) +
  geom_line(size=1.0, colour="grey") +
  geom_smooth(method="loess", se=FALSE, colour="red", size=1.2) + theme_bw() +
  scale_x_datetime(date_breaks = "1 month") +
  theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
  labs(title="\"El Principito\": Trayectoria Emocional", x="Fecha", y="Grado Emocional")
## `geom_smooth()` using formula 'y ~ x'

3.3 Obtención de sentimientos con get_percentage_values. Gráfico de trayectoria emocional

En el gráfico anterior no se aprecia muy bien la tendencia del sentimiento en el tiempo debido a la alta volatilidad en el mismo. Por ello, realizamos otro que agrupa los tweets en fragmentos de 50, graficando el valor medio de los mismos:

porcent_val <- get_percentage_values(sentimientos, bins = 50)  # Dividir en 50 fragmentos

plot(porcent_val, type="l", col="red",
     main="\"El Principito\" utilizando Medias basadas en Porcentajes",
     xlab="Tiempo Narrativo", ylab="Grado Emocional")
abline(h=0, lty=2, col="grey")

3.4 Gráfico de trayectoria emocional con simple_plot

simple_plot(sentimientos)

3.5 Análisis de sentimientos con get_nrc_sentiment

emociones <- get_nrc_sentiment(docs$texto, language = "spanish")

# Positivo y Negativo
ggplot(emociones, aes(x= sort(lavecinarubia_filt$created_at))) +
  geom_smooth(aes(y=positive, colour="Positivo"), method="loess", size=1.2, se=FALSE) +
  geom_smooth(aes(y=negative, colour= "Negativo"), method="loess", size=1.2, se=FALSE) +
  scale_colour_manual(name="", breaks=c("Positivo", "Negativo"),
                      values=c("Positivo"="#62ca35", "Negativo"="#dc143c")) + theme_bw() +
  scale_x_datetime(date_breaks = "1 month") +
  theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
  labs(title="\"El Principito\": Sentimientos (Positivo y Negativo)", x="Fecha", y="Grado Emocional")
## `geom_smooth()` using formula 'y ~ x'
## `geom_smooth()` using formula 'y ~ x'

Se observa una clara tendencia descendente del sentimiento positivo en el periodo considerado. Por su parte, el sentimiento negativo crece hasta noviembre de 2020 y luego va descendiendo hasta abril de 2021, momento en el cual vuelve a subir.

emocionesuma <- data.frame(frecuencia = apply(emociones[,1:8], 2, sum))
emocionesuma$emocion <- c("Ira", "Anticipación", "Disgusto", "Miedo", "Alegría", "Tristeza", "Sorpresa", "Confianza")
emocionesuma$tipo[c(2,5,7,8)] <- "positivo"
emocionesuma$tipo[c(1,3,4,6)] <- "negativo"
ggplot(emocionesuma, aes(x=emocion, y=frecuencia, fill=tipo)) +
  geom_bar(stat="identity") +
  scale_fill_manual(values = c("#dc143c", "#62ca35")) +
  theme_bw() + theme(legend.position="none") +
  labs(title="\"El Principito\": Tipos de Emociones", x = "Emociones", y = "Frecuencia")

Las emociones menos presentes son la sorpresa y el disgusto y las más frecuentes son la confianza y la tristeza.

emociones2 <- emociones
colnames(emociones2) <- c("Ira", "Anticipación", "Disgusto", "Miedo", "Alegría", "Tristeza",
                          "Sorpresa","Confianza", "Negativo", "Positivo")
emociones2$fecha <- sort(lavecinarubia_filt$created_at)
emociones2 <- tidyr::gather(emociones2, emocion, valor, -fecha)
emociones2 <- subset(emociones2, emocion != "Negativo" & emocion != "Positivo")
emociones2$emocion <- as.factor(emociones2$emocion)

ggplot(emociones2, aes(x=fecha, y=valor, color=emocion)) +
  geom_smooth(method="loess", size=2, se=FALSE) + theme_bw() +
  scale_color_manual(values=RColorBrewer::brewer.pal(8, "Dark2"), name="Emoción") +
  scale_x_datetime(date_breaks = "1 month") +
  theme(axis.text.x = element_text(angle = 90, vjust=0.3)) +
  labs(title="\"El Principito\": Tipos de Emociones / Tiempo", x="Fecha", y="Grado Emocional")
## `geom_smooth()` using formula 'y ~ x'

Del gráfico llama la atención como la confianza va decayendo durante todo el periodo de análisis y cómo a partir de mayo de 2021 crecen las emociones de tristeza, miedo, ira y disgusto.