Análisis de texto sobre los Programas Electorales del 10N

1 Prefacio

1.1 Técnicas de PLN

El desarrollo de la analítica de datos ha ido pareja a grandes avances en las posibilidades de captación de información.

La mayor parte de la información no está en formato numérico, y menos en una manera estructurada.

La minería de texto junto con las técnicas de Procesamiento de Lenguaje Natural nos permiten abordar con un esfuerzo razonable análisis que antes resultaban titánicos en tiempo y dinero. Las palabras ya forman parte de nuestro ámbito de información para la gestión. Y no sólo las escritas, el reconocimiento de voz nos abre un mundo de posibilidades.

1.2 Casos de uso

El caso que mostraremos a continuación enlaza muy bien con nuestras sensibilidades, y es fácilmente interpretable por el conocimiento general de los temas tratados.

Pero es sólo un ejemplo de un amplio abanico de casos de uso para este tipo de técnicas.

Un uso muy habitual es la clasificación documental en las instituciones o empresas. ¿Cómo clasificar o etiquetar automáticamente nuevos documentos para facilitar su acceso a los usuarios?

También para el tratamiento de encuestas cualitativas, no sólo en investigación de mercados sino en cualquier encuesta lanzada a empleados de organizaciones, donde interesa especialmente analizar respuestas de tipo abierto sobre los temas de interés.

¿Y si queremos conocer la imagen que tienen los clientes o usuarios de nuestra empresa? Es muy factible monitorizar a través de redes sociales los comentarios y reviews y convertirlos en KPIs de reputación corporativa, o de aceptación de un producto, o incluso de comparación de nuestros productos con los de la competencia.

En fin, todo un mundo de utilidades por descubrir e incorporar a la gestión de decisiones basadas en datos.

1.3 Elecciones 10N - 2019

1.3.1 Las palabras importan

Dicen que vivimos en un mundo cada vez más líquido donde no importa lo que se dice mientras no quede retratado por hechos ciertos y demostrados.

Lamentablemente, la realidad parece confirmarlo. La palabra ha dejado de tener carácter contractual. Incumplir lo dicho ya no tiene coste.

Sin embargo, las palabras importan, tanto las que se dicen como las que no son dichas.

Los procesos electorales se han convertido en momentos dorados para el uso e interpretación de la investigación de mercados (electores) y el desarrollo de productos (promesas electorales).

Pero las palabras importan, porque nos mueven a la acción. Y nos hacen tomar decisiones. Que no se las lleve el viento.

1.3.2 Los objetivos

El objetivo de este estudio es extraer las claves de los diferentes programas electorales para confrontarlos a través de técnicas de PLN. Se han incluido únicamente los programas oficiales publicados de los partidos, de ámbito nacional, a los que el CIS estimó representación parlamentaria.

El estudio se realizará en lenguaje R, con las librerías habituales de PLN, además de paquetes personalizados.

# Librerías necesarias
paquetes = c("tidyverse","caret", "tm", "qdap", "dplyr","stringr",
             "tidytext", "ggplot2", "tidyr","igraph","data.table",
             "pdftools", "wordcloud", "topicmodels", "ggraph","scales")
# carga o instala en su caso
comprobacion.paquetes <- lapply(paquetes, FUN = function(x) {
  if (!require(x, character.only = TRUE)) {
    install.packages(x, dependencies = TRUE)
    library(x, character.only = TRUE)
  }
})

1.3.3 Obtención de información y preparación de tidy-frame

Los programas electorales fueron descargados de cada página web oficial, bien en formato pdf, bien en formato txt, y leídos desde R con funciones tipo pdftools.

Dado el razonable volumen de información es posible realizar algunos ajustes ad-hoc en cada programa para homogeneizar los documentos y facilitar su tratamiento. Después, y usando expresiones regulares, se identifican medidas electorales, temas de campaña (políticas), y se arreglan especificidades de diseño en cada programa (guiones de cambio de línea, etc).

Hay ciertas expresiones comunes equivalentes que hay que homogeneizar (CCAA - Comunidades Autónomas, FP - Formación Profesional).

También se descartan los textos introductorios en los programas, para centrar el análisis en la confrontación de las medidas.

Hay más acciones que realizar todavía en relación con calidad del dato, pero contamos ya con una tabla con características tidy que permite ser trabajada analíticamente.

tidy_10n = read.table("tidy_10n.csv", sep = ",", stringsAsFactors = FALSE, 
                             header = TRUE, row.names = NULL)
#limpio encodings
tidy_10n$text = str_replace_all(tidy_10n$text, "<U\\+F0A7>", "")
tidy_10n$text = str_replace_all(tidy_10n$text, "<U\\+F0A0>", "")

Desplegamos tokens = palabras, que será nuestra base principal de análisis. Generamos un index de control del orden original.

tidy_10n_token <- tidy_10n %>% unnest_tokens(word, text) %>% mutate(orden_orig = seq_along(word))

De esta manera, tenemos ya una visión cuantitativa de la extensión de los diferentes programas. Vemos cómo hay gran disparidad en el despliegue, lo que sin duda tiene impacto en el análisis cuando pretendamos sacar conclusiones del conjunto de programas. Lo abordaremos más tarde a través de una normalización.

label_graficos = c("Cs", "MasPais", "PP", "PSOE", "UPodemos", "VOX")

tidy_10n_token %>% group_by(doc_id) %>%
    summarise(n_words =n())  %>%
    ggplot(aes(doc_id, n_words)) +
    geom_col(fill = "#377EB8") +
    ggtitle("Número de palabras en el Programa publicado")+
    labs(y = NULL, x = NULL)+
    geom_text(aes(y = 300, size = 30, label = label_graficos,
              vjust = 0.2, hjust = 0),alpha = 0.8, color = "white")+
    coord_flip(clip = "off", expand = TRUE)+
    theme(axis.line=element_blank(),
          axis.text.y=element_blank(),
          axis.ticks=element_blank(),
          axis.title.x=element_blank(),
          plot.title=element_text(size=15, hjust=0.5, vjust = 1, face="bold", colour="#377EB8"),
          plot.margin = margin(2,2, 2, 2, "cm"),
          legend.position="none")

Veamos este despliegue al detalle de temas (políticas) y promesas electorales (medidas) para tener una idea de la extensión de cada programa.

(camp_temas = tidy_10n_token %>% count(doc_id,capitulo) %>% add_count(doc_id) %>% 
    group_by(doc_id) %>% summarise(capits = max(n)) )
(camp_medidas = tidy_10n_token %>% filter(medida >0) %>% count(doc_id,medida) %>% add_count(doc_id) %>% 
    group_by(doc_id) %>% summarise(medids = max(n)) )
(camp_palabras = tidy_10n_token %>% count(doc_id)  )

camp_temas %>% left_join(camp_medidas, by = "doc_id") %>%
    left_join(camp_palabras, by = "doc_id") %>% 
    transmute(programa = doc_id,
           politicas = capits,
           medidas = medids,
           total_palabras = n,
           palabras_x_medida = round(n/medids,0))

En cada tema - política- se proponen una serie de medidas - promesas electorales.

Las medidas están identificadas en función de la estructura visual de cada programa, pudiendo contener cada una a su vez bloques de medidas más concretas y detalladas.

Procedemos a la preparación y limpieza de la información para su posterior tratamiento.

Primero eliminamos cualquier elemento que no sea texto (puntuaciones, dígitos, etc.) y convertimos todo a minúscula. También eliminamos espacios innecesarios.

Por último, quitamos todas las palabras que no aportan significado al texto desde el punto de vista analítico (artículos, adverbios, etc.), así como palabras concretas que no aportan en este contexto en particular.

replacePunctuation = function(x) { gsub("[[:punct:]]+", " ", x)}
replaceNumbers = function(x) { gsub("[[:digit:]]+", " ", x)}

tidy_10n_token$word = tidy_10n_token$word %>%
  replacePunctuation() %>%
  replaceNumbers() %>%
  bracketX() %>%
  tolower () %>%
  stripWhitespace()

# quitamos espacios en blanco, que ya no debería haber:
tidy_10n_token$word <- gsub("\\s+","",tidy_10n_token$word)
# eliminar stopwords
stop_words_sp = as.data.frame(stopwords("spanish"))
names(stop_words_sp) = "word"
tidy_10n_token_cleared <- tidy_10n_token %>% anti_join(stop_words_sp, by = "word")

# eliminar términos para nuestro contexto :
stop_especiales = c("véase","apartado", "así", "todas", "toda", "ello", "cualquier", "quién",
                    "puedan", "asimismo", "ser", "través", "dicha", "contemple", "suficiente",
                    "manera","tipo","solo","parte", "resto", "sino", "correspondientes",
                    "además","menos", "cs", "docs", "unas", "tal")
stop_especiales = as.data.frame(stop_especiales, stringAsFactors = FALSE)
names(stop_especiales) = "word"
tidy_10n_token_cleared = tidy_10n_token_cleared %>% anti_join(stop_especiales, by = "word")

tidy_10n_token_cleared = tidy_10n_token_cleared %>% filter(word != "")

# tabla preparada  
tidy_10n_token_cleared %>% count(word, sort = TRUE)

Aunque no parecen existir actualmente diccionarios desarrollados en castellano para unificar palabras por lexemas y dotarlas de contenido posteriormente, es posible hacerlo manualmente. Esto permitirá evitar palabras diferentes únicamente por declinaciones, plurales , etc.

# library(SnowballC)  #-> wordStem aisla el lexema de cada palabra
palabras_unicas = tidy_10n_token_cleared %>% count(word, sort = TRUE)
zz = tidy_10n_token_cleared %>% group_by(word) %>% 
  mutate(word_stem = SnowballC::wordStem(word, language = "spanish")) %>%
  left_join(palabras_unicas, by = "word")
# identifico las equivalencias más frecuentes en mi texto entre palabras y lexemas : es mi diccionario de lexemas para este texto
tops_lems = zz %>% count(word_stem, word) %>% 
                    group_by(word_stem) %>% 
                    mutate(rank = rank(-n, ties.method= "random")) %>%
                    filter(rank ==1)
# finalmente, asigno a cada lexema la palabra de mi texto más frecuente :
tidy_10n_token_cleared = tidy_10n_token_cleared %>%
  mutate(word_stem = SnowballC::wordStem(word, language = "spanish"))%>%
  left_join(tops_lems, by = "word_stem")

tidy_10n_token_cleared = tidy_10n_token_cleared %>% select(1:4,6,8) %>%
  mutate(word = word.y) %>% select(-word.y)

# y hacemos algunos a mano, debido a las declinaciones irregulares
sort(table(str_subset(tidy_10n_token_cleared$word, "garantic")),decreasing = TRUE)

## garantice 
##        44

tidy_10n_token_cleared$word = gsub("garantic.+", "garantizar", tidy_10n_token_cleared$word)
sort(table(str_subset(tidy_10n_token_cleared$word, "acce")),decreasing = TRUE)

## 
##        acceso       acceder accesibilidad 
##           140            20            16

tidy_10n_token_cleared$word = gsub("acce.+", "acceso", tidy_10n_token_cleared$word)
sort(table(str_subset(tidy_10n_token_cleared$word, "lau")),decreasing = TRUE)

## launión 
##      44

tidy_10n_token_cleared$word = gsub("launión", "unión", tidy_10n_token_cleared$word)

# tabla obtenida 
tidy_10n_token_cleared %>% count(word, sort = TRUE)

Observamos la diferencia en el top palabras una vez unificados lexemas. “Público” es la palabra más utilizada al unirse “público”, “pública”, “públicos”, etc … También conseguimos reducir a la mitad el número de palabras en el análisis.

En el caso de “española”, recoge toda las palabras “español”, “española”, “españoles”, “españolas”, etc, y es su representante por ser la más utilizada de todas ellas en los textos

Por último, eliminamos también las palabras que sólo aparecen una vez entre todos los programas, para simplificar los listados. A la vez, normalizamos la frecuencias de palabras dentro de cada programa para eliminar el impacto de los programas más extensos versus los más concisos.

infrecuentes_eliminar = tidy_10n_token_cleared %>% count(doc_id, word) %>% filter(n<2)

tidy_10n_token_cleared = tidy_10n_token_cleared %>% 
  group_by(doc_id) %>% summarise(total_words = n()) %>%
  left_join(tidy_10n_token_cleared, by= "doc_id") %>%
  anti_join(infrecuentes_eliminar, by = c("doc_id", "word")) %>%
  mutate(peso = (1/total_words*10000))

tidy_10n_token_cleared = tidy_10n_token_cleared %>% select(-total_words) 

# tabla definitiva   
tidy_10n_token_cleared %>% count(word, wt = peso, sort = TRUE) %>% mutate(n= round(n,0))

Ya tenemos una tabla lista para el análisis.

2 Análisis exploratorio

2.1 Visión general

Lanzamos algunos gráficos generales para observar el texto : primero una nube de palabras con los términos más utilizados.

tidy_10n_token_cleared %>% 
  count(word, wt = peso, sort = TRUE) %>%
  with(wordcloud(word, n, max.words = 200, random.order=FALSE, random.color=FALSE, rot.per=.1,                  scale=c(6,.5), colors = c("grey80","darkgoldenrod1", "tomato")))

El paquete Wordcloud tiene funciones para generar nubes con los términos que son comunes a todos los programas

pal <- brewer.pal( 8, "Accent")
#use the darker colors
pal <- pal[-( 1: 5)]
#generate the commonality cloud : palabras comunes a todos los documentos
# selecciono 4 documentos
tidy_temp = tidy_10n_token_cleared %>% count(doc_id, word, wt = peso)%>%
  cast_dtm(word, doc_id, n) 
tidy_temp = as.matrix(tidy_temp)
commonality.cloud(tidy_temp, max.words = 200, comonality.measure=mean,  # por defecto min
                  random.order = FALSE, colors = pal)

y los términos que diferencian en mayor medida relativa cada programa de los demás.

# pantone de cada partido
partidos_colores = c("#ff8000", "darkgreen", "#3b83bd",
                     "#c81d11", "#572364", "#00bb2d")

comparison.cloud(tidy_temp, max.words = 200, rot.per=.0, title.size=2, scale=c(5,.5),
                 colors = partidos_colores, 
                 match.colors = TRUE, title.bg.colors=c("black"),
                 use.r.layout = TRUE)

2.2 Confrontando programas

Entremos un poco más al detalle de cada discurso, comparando el top palabras más utilizado en cada programa.

tidy_10n_token_cleared$doc_id <- factor(tidy_10n_token_cleared$doc_id, labels = label_graficos)

tidy_10n_token_cleared %>%
  count(doc_id, word, sort = TRUE) %>%   # aqui con frecuencia sin ajustar peso
  group_by(doc_id) %>%
    mutate(rank = rank(-n, ties.method= "random")) %>%
    filter(rank <=25) %>%
  ungroup() %>%
  mutate(word = reorder_within(word, n, doc_id)) %>%
  ggplot(aes(word, n, fill = doc_id)) +
  geom_col(show.legend = FALSE) +
  geom_text(aes(x = word, y = 0.5, label = str_replace(word, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
              hjust = 0, vjust = 0.3, size=4, colour = "white",
              fontface="bold") + 
  labs(x = NULL, y = NULL) +
  facet_wrap(~doc_id, ncol = 9, scales = "free", labeller = labeller(label_graficos)) +
  coord_flip() +
  scale_x_reordered() +
  ggtitle("Palabras más  empleadas en cada Programa-10N")+
  scale_fill_manual(values = partidos_colores)+
  theme(axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                              face="plain", colour="black"),
      plot.margin = margin(1,1, 2, 1, "cm"),
      legend.position="none")

Si utilizamos los bigramas, es decir, las parejas de palabras que aparecen juntas con mayor frecuencia, observamos ideas más concretas

# reconstruimos la tabla con bigramas
untidy_all = tidy_10n_token_cleared %>% group_by(doc_id) %>%
  summarise(capitulo = first(capitulo), text=paste(word, collapse =" "))
JLM_bigrams <- untidy_all %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

bigrams_separated <- JLM_bigrams %>% separate(bigram, c("word1", "word2"), sep = " ")
bigram_counts = bigrams_separated %>% count(word1, word2, sort = TRUE)

# y mostramos
JLM_bigrams %>%
  count(doc_id, bigram, sort = TRUE)  %>%
  group_by(doc_id) %>%
  mutate(rank = rank(-n, ties.method= "random")) %>%
  filter(rank <=20) %>%
  ungroup() %>%
  mutate(bigram = reorder_within(bigram, n, doc_id)) %>%
  ggplot(aes(bigram, n, fill = doc_id)) +
  geom_col(show.legend = FALSE, alpha = 0.5) +
  geom_text(aes(x = bigram, y = 0.2, label = str_replace(bigram, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
              hjust = 0, vjust = 0.3, size=4, colour = "black",
              fontface="bold") + 
  labs(x = NULL, y = NULL) +
  facet_wrap(~doc_id, ncol = 9, scales = "free") +
  coord_flip() +
  scale_x_reordered()+
  ggtitle("Most common bigrams - 10N")+
  scale_fill_manual(values = partidos_colores)+
  theme(axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                              face="plain", colour="black"),
      plot.margin = margin(1,1, 2, 1, "cm"),
      legend.position="none")

Hay algunos resultados extraños debido a los lexemas (trabajo-trabajo viene de trabajadores y trabajadoras en el texto del programa correspondiente, al igual que niños-niños desde niños-niñas). Por otro lado, las parejas i-d y d-i provienen de I+D+I (políticas sobre investigación + desarrollo + innovación), quizá debiéramos unirlos y tratarlo como una palabra única.

En todo caso, es posible ver al detalle cómo aparecen a la vez en los documentos ciertas palabras en concreto, para resolver este tipo de situaciones…

# para localizar palabras
bigrams_separated %>%
  filter(word1 == "cataluña") %>%
  count(word1, word2, sort = TRUE)

…o indagar cómo y en qué medida aparecen ciertos términos.

También podemos analizar cómo aparece relacionado cierto término en cada uno de los programas…

# y puedo ver al detalle asociaciones de una palabra en concreto
palabra_a_analizar = "familia"  # en este caso el lexema con regexpr
bigrams_separated %>% filter(grepl(palabra_a_analizar, word1)) %>%
  group_by(doc_id, word1, word2) %>%
  summarise ( n = n()) %>%  arrange(desc(n)) %>% 
  mutate(rank = rank(-n, ties.method= "random")) %>%
  filter(rank <=10) %>%
  ungroup %>%
  mutate(word2 = reorder_within(word2, n, doc_id)) %>%
  ggplot(aes(word2, n)) +
  geom_col(fill = "darkred", alpha = 0.4) +
  geom_text(aes(x = word2, y = 0.1, label = str_replace(word2, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
              hjust = 0, vjust = 0.3, size=4, colour = "black",
              fontface="bold") + 
  xlab(NULL) + ylab(NULL) +
  facet_wrap(~doc_id, ncol = 7, scales = "free") +
  coord_flip() +
  scale_x_reordered()+
  ggtitle(paste ("Palabras más asociadas a  \"", palabra_a_analizar,"..\"  por Programa"))+
  theme(axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                              face="plain", colour="black"),
      plot.margin = margin(1,1, 2, 1, "cm"),
      legend.position="none")

“número” funciona como palabra principal del lexema “numer”, con lo que aquí se refiere sin duda a familia numerosa.

Por último, el uso de trigramas, aunque implica una frecuencia mucho menor de posibilidad de aparición, sin embargo nos transmite casi frases completas.

# la frecuencia de trigramas a lo largo de toda la colección
JLM_trigrams <- untidy_all %>%
  unnest_tokens(trigram, text, token = "ngrams", n = 3) %>%
  count(doc_id, trigram, sort = TRUE) %>%
  filter(!is.na(trigram))
(aa3 = JLM_trigrams %>%
  group_by(doc_id) %>%
  mutate(rank = rank(-n, ties.method= "random")) %>%
  filter(rank <=10) %>%
  ungroup() %>%
  mutate(trigram = reorder_within(trigram, n, doc_id)) %>%
  ggplot(aes(trigram, n, fill = doc_id)) +
  geom_col(show.legend = FALSE, alpha = 0.3) +
  geom_text(aes(x = trigram, y = 0.1, label = str_replace(trigram, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
              hjust = 0, vjust = 0.3, size=4, colour = "black",
              fontface="plain") + 
  labs(x = NULL, y = NULL) +
  facet_wrap(~doc_id, ncol = 9, scales = "free") +
  coord_flip() +
  scale_x_reordered()+
  ggtitle("Most common trigrams - 10N")+
  scale_fill_manual(values = partidos_colores)+
  theme(axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                              face="plain", colour="black"),
      plot.margin = margin(1,1, 2, 1, "cm"),
      legend.position="none")
)

2.3 Una visión general con Grafos

Los grafos son una herramienta muy útil cuando existe mucha cantidad de información de relaciones entre elementos. En nuestro caso, los bigramas son relaciones entre 2 palabras, medidas además por la frecuencia de ocurrencia.

Con el paquete “igraph” podemos ver de manera ágil las co-ocurrencias por programa electoral.

partys = unique(tidy_10n_token_cleared$doc_id)
plot_list = list()
filter_n = c(4,7,3,4,7,2) # minimos frecuencias mostrar

for(i in 1:length(partys)) {
print(partys[i])
bigrams_separated <- JLM_bigrams %>% filter(doc_id == partys[i])%>%
  separate(bigram, c("word1", "word2"), sep = " ")

bigram_counts = bigrams_separated %>% count(word1, word2, sort = TRUE)

bigram_graph <- bigram_counts %>%
  filter(n > filter_n[i] & !is.na(word1)) %>%
  graph_from_data_frame()

set.seed(2016)
a <- grid::arrow(type = "closed", length = unit(.15, "inches"))
(bb99 = ggraph(bigram_graph, layout = "fr") +
    geom_edge_link(aes(edge_alpha = n, edge_width = n), 
                   edge_colour = "cyan4", show.legend = TRUE,
                   arrow = a, end_cap = circle(.07, 'inches')) +
    geom_node_point(color = "lightblue", size = 5) +
    geom_node_text(aes(label = name), repel = TRUE,
                   point.padding = unit(0.2, "lines"),
                   vjust = 1, hjust = 1) +
    theme_void()+
    theme(legend.position = c(0.9, 0.1))+
    ggtitle(paste0("Co-ocurrencias : ",partys[i], "  (n>",filter_n[i], ")"))
)
plot_list[[i]] = bb99
} 

El grosor de los enlaces muestran los diferentes niveles de co-ocurrencia entre palabras.

2.4 TfIdf en lugar de Frecuencias

Lo cierto es que normalmente hay palabras que aparecen mucho en todos los programas, como “público”, “nacional”, etc y que son las que copan el top palabras. Son como árboles que no nos dejan ver el bosque de las palabras propias y no tan compartidas de los documentos analizados.

El estadístico tf-idf (Term Frequency and Inverse Document Frequency) busca medir la importancia de una palabra para un documento (programa electoral) dentro de una colección de ellos (todos los programas). Es decir, penaliza la aparición en todos los programas electorales y premia la exclusividad respecto al resto.

Si en lugar de frecuencias de aparición utilizamos ésta conversión a TfidF, estaremos observando de alguna manera las palabras que son más “propias” de cada programa comparado con el resto.

book_words_sp = tidy_10n_token_cleared %>% 
  count(doc_id, word, sort = TRUE) %>%  filter(n>4) %>%
  bind_tf_idf(word, doc_id, n)

book_words_sp %>%
  group_by(doc_id) %>% 
    mutate(rank = rank(-tf_idf, ties.method= "random")) %>%
    filter(rank <=10) %>%
  ungroup() %>%
  mutate(word = reorder_within(word, tf_idf, doc_id)) %>%
  ggplot(aes(word, tf_idf, fill = doc_id)) +
  geom_col(show.legend = FALSE) +
  labs(x = NULL, y = NULL) +
  coord_flip()+
  scale_x_reordered() +
  ggtitle("Palabras propias de cada Programa (TfIdf)")+
  scale_fill_manual(values = partidos_colores)+
  geom_text(aes(x = word, y = 0.000015, label = str_replace(word, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
              hjust = 0, vjust = 0.3, size=4, colour = "white",
              fontface="bold") + 
  facet_wrap(~doc_id, ncol = 9, scales = "free", labeller = labeller(label_graficos)) +
  theme(axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      axis.text.x = element_blank(),
      plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                              face="plain", colour="black"),
      plot.margin = margin(1,1, 2, 1, "cm"),
      legend.position="none")

Igualmente con los bigramas, utilizando la conversión a Tf-Idf, podemos ver ideas más diferenciales de cada programa electoral.

untidy_all = tidy_10n_token_cleared %>% group_by(doc_id) %>%
  summarise(capitulo = first(capitulo), text=paste(word, collapse =" "))
JLM_bigrams <- untidy_all %>%
  unnest_tokens(bigram, text, token = "ngrams", n = 2)

bigrams_separated <- JLM_bigrams %>%
  separate(bigram, c("word1", "word2"), sep = " ")
# new bigram counts:
bigram_counts <- bigrams_separated %>% 
  count(word1, word2, sort = TRUE)

bigram_tf_idf <- JLM_bigrams %>%
  count(doc_id, bigram) %>%
  bind_tf_idf(bigram, doc_id, n) %>%
  arrange(desc(tf_idf)) %>% filter(n>1)

bigram_tf_idf %>%
  arrange(desc(tf_idf)) %>%
  group_by(doc_id) %>% 
    mutate(rank = rank(-tf_idf, ties.method= "random")) %>%
    filter(rank <=10) %>% 
  ungroup() %>%
  mutate(bigram = reorder_within(bigram, tf_idf, doc_id)) %>% 
  ggplot(aes(bigram, tf_idf, fill = doc_id)) +
  geom_col(show.legend = FALSE, alpha = 0.4) +
  geom_text(aes(x = bigram, y = 0.000015, label = str_replace(bigram, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
              hjust = 0, vjust = 0.3, size=4, colour = "gray50",
              fontface="bold") +
  labs(x = NULL, y = NULL) +
  facet_wrap(~doc_id, ncol = 9, scales = "free") +
  coord_flip() +
  scale_x_reordered()+
  ggtitle("Bigramas propios de cada Programa (TfIdf)")+
  scale_fill_manual(values = partidos_colores)+
  theme(axis.text.y = element_blank(),
      axis.ticks = element_blank(),
      axis.text.x = element_blank(),
      plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                              face="plain", colour="black"),
      plot.margin = margin(1,1, 2, 1, "cm"),
      legend.position="none")

2.5 Correlación entre palabras

Por último, y al igual que hemos visto con el estadístico Tf-Idf, los grafos de correlación entre palabras nos muestran especificidades. En este caso, las palabras que aparecen juntas en mayor medida de que lo hacen junto a otras.

library(widyr)
word_cors <- tidy_10n_token_cleared %>% group_by(word) %>% filter(n() >= 10) %>%
  pairwise_cor(word, lineatexto, sort = TRUE)
head(word_cors,50)

# Filtrando de una manera sencilla podemos encontrar las palabras más correlacionadas con cualquiera que nos interese.
word_cors %>% filter(item1 == "policía")

O mostrarlas gráficamente.

word_cors %>%
  filter(item1 %in% c("corrupción", "empleo", "seguridad", 
                      "derechos", "bienestar", "igualdad")) %>%
  group_by(item1) %>%
  top_n(10) %>%
  ungroup() %>%
  mutate(item2 = reorder_within(item2, correlation, item1)) %>%
  ggplot(aes(item2, correlation, fill = item1)) +
  geom_bar(stat = "identity", show.legend = FALSE, alpha = 0.9) +
  geom_text(aes(x = item2, y = 0.000015, label = str_replace(item2, "(.+)___.+", replacement = str_c(" ", "\\1"))), 
            hjust = 0, vjust = 0.3, size=4, colour = "white",
            fontface="bold") + 
  ylab(NULL) +
  facet_wrap(~ item1, scales = "free") +
  scale_x_reordered() +
  coord_flip()+
  ggtitle("Palabras de mayor correlación con cada caso")+
  theme(axis.text.y = element_blank(),
    axis.ticks = element_blank(),
    axis.text.x = element_blank(),
    plot.title=element_text(size=15, hjust=0.5, vjust = 1, 
                            face="plain", colour="black"),
    plot.margin = margin(1,1, 2, 1, "cm"),
    legend.position="none")

Y podemos igualmente crear un grafo de correlaciones para detectar las palabras que aparecen juntas en los documentos en mucha mayor medida a la que aparecen con otras palabras diferentes.

partys = unique(tidy_10n_token_cleared$doc_id)
plot_list = list()
min_corr = c(.30, .45, .30, .35, .50, .001)

for(i in 1:length(partys)) {
  print(partys[i])
  # we need to filter for at least relatively common words first
  word_cors <- tidy_10n_token_cleared %>%
    filter (doc_id == partys[i]) %>%
    group_by(word) %>%
    filter(n() >= 10) %>%
    pairwise_cor(word, lineatexto, sort = TRUE)
  set.seed(2016)
  (af1 = word_cors %>%
    filter(correlation > min_corr[i]) %>%
    graph_from_data_frame() %>%
    ggraph(layout = "fr") +
    geom_edge_link(aes(edge_alpha = correlation), show.legend = FALSE) +
    geom_node_point(color = "gold", size = 5) +
    geom_node_text(aes(label = name), repel = TRUE) +
    theme_void()+
    ggtitle(paste0("Correlaciones > ", min_corr[i], ": " , partys[i]))
  )
  plot_list[[i]] = af1
}

3 Comparando programas

La frecuencia de uso de las palabras puede ser comparada entre los distintos programas, de una manera global, para detectar similitudes o diferencias en el uso del léxico entre programas.

frequency_relatos <- tidy_10n_token_cleared %>% 
  count(doc_id, word) %>%
  group_by(doc_id) %>%
  mutate(proportion = n / sum(n)) %>% 
  select(-n) %>% 
  spread(doc_id, proportion)
# correlaciones entre programas :
library(GGally)
ggpairs(frequency_relatos[2:7],title = "Correlaciones entre programas")

La función ggpairs nos muestra las correlaciones cruzadas entre todos los programas, en función de las frecuencias de uso de palabras. ¿Sorprende algún resultado?

Podemos verlo comparando 2 a 2 algunos casos. Los ejes reflejan la proporción de uso de las palabras en cada documento. La línea diagonal nos muestra el eje de similitud entre los programas en cuanto a la frecuencia de uso de palabras. A mayor dispersión de puntos, menor similitud entre programas (menos correlación).

# un ejemplo
a1 = ggplot(frequency_relatos, aes(x = Cs, 
                              y = PP, 
                              color = abs(Cs - PP))) +
  geom_abline(color = "gray40", lty = 2) +
  geom_jitter(alpha = 0.1, size = 2.5, width = 0.3, height = 0.3) +
  geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +
  scale_x_log10(labels = NULL) + #percent_format()) +
  scale_y_log10(labels = NULL) + #percent_format()) +
  scale_color_gradient(#limits = c(0, 0.001),
    low = "lightblue",
    high = "darkblue", name="Contraste") +
  theme(legend.position=c(0.9, 0.2))+
  ggtitle("Comparando uso de palabras Cs - PP")

# los extremos se tocan ?
a2 = ggplot(frequency_relatos, aes(x = VOX, 
                              y = UPodemos, 
                              color = abs(VOX - UPodemos))) +
  geom_abline(color = "gray40", lty = 2) +
  geom_jitter(alpha = 0.1, size = 2.5, width = 0.3, height = 0.3) +
  geom_text(aes(label = word), check_overlap = TRUE, vjust = 1.5) +
  scale_x_log10(labels = NULL) + #percent_format()) +
  scale_y_log10(labels = NULL) + #percent_format()) +
  scale_color_gradient(#limits = c(0, 0.001),
    low = "lightblue",
    high = "darkblue", name="Contraste") +
  theme(legend.position=c(0.9, 0.2))+
  ggtitle("Comparando uso de palabras VOX - Podemos")

multiplot(a1, a2, cols = 2)