Inicio

Objetivo del trabajo

Este trabajo intenta dar una idea de cómo se podría encarar el proceso de creación de features utilizando análisis de text mining cuando se intenta predecir un evento binario.

Es necesario aclarar que este análisis es puramente metodológico, no tienen intenciones políticas, y además cuenta con muy poco volúmen de datos como para sacar conclusiones claras. El objetivo es simplemente proponer una metodología de trabajo a seguir cuando se trabaja con datos de tipo texto y se quiere encontrar patrones que ayuden a predecir la ocurrencia de un evento binario.

Evento a predecir

Para aprovechar el data set facilitado por el proyecto de #datosdemieRcoles, se intentará predecir la probabilidad de que una línea de texto corresponda al programa del candidato Macri.

Para eso, se creará una variable binaria que indique un “1” cuando la línea analizada efectivamente corresponde al candidato “Macri”, y un “0” en otro caso. Todo el análisis se centrará en dicha marca. El objetivo será encontrar patrones que permitan diferenciar con mayor certeza las líneas del programa de Macri vs las líneas del programa de Fernandez. 

#### Codigo para levantar los data sets y limpiarlos ####

#### Levanto los data sets

fernandez <- readr::read_csv("https://raw.githubusercontent.com/cienciadedatos/datos-de-miercoles/master/datos/2019/2019-09-04/argentina_frente-de-todos_fernandez_2019.txt")

macri <- readr::read_csv("https://raw.githubusercontent.com/cienciadedatos/datos-de-miercoles/master/datos/2019/2019-09-04/argentina_juntos-por-el-cambio_macri_2019.txt")


#### Abro las librerias necesarias

library(dplyr)
library(tidytext)
library(ggplot2)
library(purrr)
library(stringr)
library(tidyr)
library(forcats)
library(plotly)
library(collapsibleTree)

#### Convierto el set de datos en tipo "tibble"

fernandez <- tibble(line = 1:nrow(fernandez), text = fernandez$INTRODUCCIÓN)
macri <- tibble(line = 1:nrow(macri), text = macri$CAMBIEMOS)

#### Uno los dos data sets en uno solo

propuestas <- rbind(fernandez,macri)

#### Creo la variable binaria que diferencia con un "1" a las lineas correspondientes a Macri. 

propuestas$Candidato <- c(rep(0,nrow(fernandez)),
                          rep(1,nrow(macri)))

Tokenización

Dado que se intenta descubrir features que sirvan para predecir cuándo una línea de un programa corresponda al candidato Macri, se realizará un primer análisis teniendo en cuenta las palabras que componen cada línea.

Para ello, se procede con la limpieza y tokenización de la base.

Desplegá el código para ver cómo limpio la base! 

#### Defino una funcion para limpiar y tokenizar los datos

limpiar_df <- function(texto){
  # El orden de la limpieza no es arbitrario
  # Se convierte todo el texto a minúsculas
  nuevo_texto <- tolower(texto)
  # Eliminación de páginas web (palabras que empiezan por "http." seguidas 
  # de cualquier cosa que no sea un espacio)
  nuevo_texto <- str_replace_all(nuevo_texto,"http\\S*", "")
  # Eliminación de signos de puntuación
  nuevo_texto <- str_replace_all(nuevo_texto,"[[:punct:]]", " ")
  #Elimino tildes en las letras
  nuevo_texto<-stringi::stri_trans_general(nuevo_texto,"Latin-ASCII")
  # Eliminación de números
  nuevo_texto <- str_replace_all(nuevo_texto,"[[:digit:]]", " ")
  # Eliminación de espacios en blanco múltiples
  nuevo_texto <- str_replace_all(nuevo_texto,"[\\s]+", " ")
  # Tokenización por palabras individuales
  nuevo_texto <- str_split(nuevo_texto, " ")[[1]]
  # Eliminación de tokens con una longitud < 2
  nuevo_texto <- keep(.x = nuevo_texto, .p = function(x){str_length(x) > 1})
  return(nuevo_texto)
}


#### Limpio y tokenizo los datos 

propuestas <- propuestas %>% mutate(texto_tokenizado = map(.x = text,
                                                           .f = limpiar_df))


#### Creo un nuevo data set ordenado, donde tengo una fila por palabra:

data_tidy <- propuestas %>% select(-text) %>% unnest()
data_tidy <- data_tidy %>% rename(token = texto_tokenizado)

Punto de Partida

¿Qué es lo primero que tengo que saber?

  • Teniendo en cuenta que se intentará clasificar a cada línea de cada programa, se debe conocer qué proporción del total de las líneas y de las palabras analizadas corresponde al programa de Macri.
  • Esto es para conocer con anticipación cuál es la “Tasa Promedio de Éxito” que deberíamos intentar aperturar.

Lineas

Distribución de líneas 

resumen <- propuestas  %>% 
  group_by(Candidato) %>% 
  count(Candidato)

resumen$Pct_Lines <- resumen$n/sum(resumen$n)
resumen$Candidato <- as.factor(resumen$Candidato)

p <- ggplot(resumen, 
            aes(x=Candidato, 
                y=Pct_Lines, 
                fill=Candidato)) + 
  geom_bar(stat="identity",
           color = 'black') + 
  ggtitle("Distribución del total de lineas\nde ambos programas") + 
  xlab("Es Macri") + ylab("Porcentaje") +
  scale_fill_manual(values=c("#68a4bd","#fff000"), name="Es Macri") +
  geom_text(aes(label=paste0(round(resumen$Pct_Lines*100,0),"%")), position=position_dodge(width=0.9), vjust=0.5,size=12) +
  ylim(0, 0.9) +
  theme_minimal()

ggplotly(p)

Palabras

Distribución de palabras 

resumen <- data_tidy  %>% 
  group_by(Candidato) %>% 
  count(Candidato)

resumen$Pct <- resumen$n/sum(resumen$n)
resumen$Candidato <- as.factor(resumen$Candidato)

p <- ggplot(resumen, 
            aes(x=Candidato, 
                y=Pct, 
                fill=Candidato)) + 
  geom_bar(stat="identity",
           color = 'black') + 
  ggtitle("Distribución del total de palabras\nde ambos programas") + 
  xlab("Es Macri") + ylab("Porcentaje") +
  scale_fill_manual(values=c("#68a4bd","#fff000"), name="Es Macri") +
  geom_text(aes(label=paste0(round(resumen$Pct*100,0),"%")), position=position_dodge(width=0.9), vjust=0.5,size=12) +
  ylim(0, 0.9) +
  theme_minimal()

ggplotly(p)

Conclusion

  • Finalmente, de se observa que el 33% del total de líneas y el 34% del total de las palabras corresponde al programa de Macri (la distribución es muy similar).

  • Teniendo en cuenta que el objetivo del problema planteado consiste en clasificar a cada línea de un programa en “Es de Macri” o “No es de Macri”, con este análisis se debería poder encontrar palabras o conjuntos de palabras en donde la tasa de éxito (es decir, la probabilidad de pertenecer al programa de Macri) sea ampliamente superior o inferior al promedio.

Primera Busqueda

Palabras y tasas de éxito asociadas

En este apartado se realizará un análisis de la tasa de éxito asociada cada una de las palabras que aparecen mencionadas en ambos programas.

El objetivo es encontrar qué palabras son las que están más presentes en los programas de Macri pero NO en el programa de Fernandez, y viceversa.

Por ejemplo, si vemos que la palabra “crisis” aparece una mayor proporción de veces en el programa de Fernandez respecto del programa de Macri, entonces podemos inferir que las líneas que contengan la palabra “crisis” cuentan con una menor probabilidad de pertenecer al programa de Macri.

Para llevar a cabo este análisis, se realizó un conteo del total de palabras que aparecen en ambos programas, excluyendo las Stop Words (definidas según mi criterio). Para tener un poco de robustez (más allá de que los volúmenes tratados en este data set son muy bajos), se exigió que la palabra aparezca al menos 6 veces en cualquiera de los dos documentos.

Se calculó la tasa de éxito asociada a cada palabra como la proporción de veces en que esa palabra aparece en el programa de Macri, respecto la cantidad de veces total que se menciona la palabra en ambos programas.

Visualizacion

# Defino el listado de Stop Words:

stop_words_general <- c("de","la","el","en","las","que","los",
                        "un","del","para","una","se","con",
                        "es","por","al","su","como","ello","esta",
                        "mas","sus","debe","este","no","sobre","desde",
                        "as","tiene","tambien","entre","ha","esto","nos",
                        "puede","cada","lo","otra","otro","sin","ante",
                        "estar","gran","lo","mayor","tal","tanto","si",
                        "sera","todo","ademas","dan","cuando","alla",
                        "la", "las", "el", "los", "a", "ante", "bajo", 
                        "cabe", "con", "contra", "de",
                        "desde", "durante", "en", "entre", "hacia", 
                        "hasta", "mediante", "para", "por",
                        "segun", "sin", "so", "sobre", "tras", "versus","via",
                        "me", "se", "una", "te", "esta", "tu", "pero", "yo", "como", 
                        "ya", "mi","aqui","le", "no", "si", "ha", 
                        "mas", "su", "nos", "hay", "he","no","si","ha",
                        "eso","mas","todo","su","nos","hay","he","va","voy","porque","eh","nada",
                        "muy","ahi","asi","todos","estas","favor", "hacer", "pues", "esto","cuando",
                        "este", "soy", "ni", "tengo", "donde" ,"dos","has","ese", "estan",
                        "uno","dos","tres","cuatro","cinco","seis","siete","ocho","nueve","diez",
                        "casi","cabo","ir","hora")

# Hago un conteo por palabra, excluyendo las stop words, y calculo la proporción de éxito de cada palbra (esto es, de la cantidad total de veces que aparece la palabra, cuál es la porción de veces que aparece en el programa de Macri):

 data_tidy  %>% 
   filter(!token %in% stop_words_general) %>%
   group_by(token) %>%
   summarise(n=length(Candidato),
             Prop_exito = mean(Candidato)) -> conteo

# Para el analisis me quedo con las palabras que aparecen al menos 6 veces, ya que sino estoy trabajando con palabras muy poco frecuentes 
 
 conteo %>% 
   filter(n>=6) -> conteo

# Visualizo los resultados 
 
 # Primero ordeno la tabla de mayor a menor probabilidad de exito
 
 conteo <- conteo[order(-conteo$Prop_exito),]
 
 # Luego convierto en factor las palabras, para que GGPLOT mantenga el orden 
 
 conteo$token <- factor(conteo$token, levels=unique(conteo$token))
 
 # Armo el gráfico base
 
 ggplot(data=conteo, 
        aes(x=token, y=Prop_exito, group=1)) +
   geom_line(colour=c("#f9bb13"),size=1.5) +
   geom_point(colour=c("#ff9900"),size=2) +
   theme_minimal() +
   ggtitle("Tasas de éxito por palabra") + 
   xlab("Palabra") + ylab("Tasa de Éxito") +
   theme(axis.text.x = element_text(angle = 90,size=10),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5)) -> p
 

 # Le agrego la tasa media de manera horizontal
 
 p +
   geom_hline(yintercept=mean(data_tidy$Candidato),
              linetype="dashed",
              color="black",
              size=1.5) -> p
 
 # Le agrego el texto que diga cuanto es la tasa promedio 
 
 p + 
  geom_text(aes(x=1,
                y=round(mean(data_tidy$Candidato),1)*0.9,
                label=paste0("Tasa Media: ",round(mean(data_tidy$Candidato)*100,0),"%")), 
            hjust=0, size=6) -> p
 
 # Defino las lineas verticales que voy a graficar 
 
 # Para las categorias con mayor y menor probabilidad de exito 
 
 MAYOR_1 <- length(conteo$token[conteo$Prop_exito>mean(data_tidy$Candidato)*1.75])
 MAYOR_0 <- length(conteo$token[conteo$Prop_exito>mean(data_tidy$Candidato)*1.1])
 MENOR_0 <- length(conteo$token[conteo$Prop_exito>mean(data_tidy$Candidato)*0.9])
 MENOR_1 <- length(conteo$token[conteo$Prop_exito>mean(data_tidy$Candidato)*0.1])
 
# Agrego las secciones pintadas de mas o menos tasa de exito
 
 p + 
   # Esto es para agregar la linea vertical:
   geom_vline(xintercept = MAYOR_1,
              color="palegreen4",
              size=1) +
   
   #Esto es para agregar el relleno: 
   annotate("rect",
            xmin=1,
            xmax = MAYOR_1,
            ymin=-0.25, 
            ymax=1.3, 
            alpha=.2, fill="palegreen4") +
   
   # Esto es para agregar el texto:
   geom_text(aes(x=(1+MAYOR_1)/2,
                y=1.1,
                label=paste0("Palabras con\n tasa de éxito\n al menos un \n75% superior\n a la media")), 
            hjust=0.5, size=3.5)-> p
 
 
 # Se repite la misma estructura de codigo: 
 
  p + 
   geom_vline(xintercept = MAYOR_0,
              color="palegreen3",
              size=1) +
   annotate("rect",
            xmin= MAYOR_1,
            xmax = MAYOR_0,
            ymin=-0.25, 
            ymax=1.3, 
            alpha=.2, fill="palegreen3") +
   geom_text(aes(x=(MAYOR_0+MAYOR_1)/2,
                y=1.1,
                label=paste0("Palabras con\n tasa de éxito\n al menos un \n10% superior\n a la media")), 
            hjust=0.5, size=3.5)-> p
  
   p + 
   geom_vline(xintercept = MENOR_0,
              color="salmon3",
              size=1)+
   annotate("rect",
            xmin= MAYOR_0,
            xmax = MENOR_0,
            ymin=-0.25, 
            ymax=1.3, 
            alpha=.2, fill="lightgoldenrodyellow") +
   geom_text(aes(x=(MAYOR_0+MENOR_0)/2,
                y=1.1,
                label=paste0("Palabras con\ntasa de éxito\n muy similares \n a la media")), 
            hjust=0.5, size=3.5)-> p
   
    p + 
   geom_vline(xintercept = MENOR_1,
              color="salmon4",
              size=1) +
   annotate("rect",
            xmin= MENOR_0,
            xmax = MENOR_1,
            ymin=-0.25, 
            ymax=1.3, 
            alpha=.2, fill="salmon3") +
   geom_text(aes(x=(MENOR_1+MENOR_0)/2,
                y=1.1,
                label=paste0("Palabras con\n tasa de éxito\n al menos un\n 10% inferior\n a la media")), 
            hjust=0.5, size=3.5)-> p
    
     p + 
   annotate("rect",
            xmin= MENOR_1,
            xmax = length(conteo$token),
            ymin=-0.25, 
            ymax=1.3, 
            alpha=.2, fill="salmon4") +
   geom_text(aes(x=(MENOR_1+length(conteo$token))/2,
                y=1.1,
                label=paste0("Palabras con\n tasa de éxito\n al menos un\n 50% inferior\n a la media")), 
            hjust=0.5, size=3.5)-> p
 
p

Qué vemos en ese gráfico?

La línea amarilla representa la tasa de éxito asociada a cada palabra. Ordenamos las palabras de mayor a menor tasa de éxito para que tenga sentido la clasificación de colores.

Teniendo en cuenta la tasa de éxito promedio (33%), se separaron 5 grupos de palabras: - Las que cuentan con una tasa de éxito al menos un 75% superior al promedio - Las que cuentan con una tasa de éxito entre un 10% y un 75% superior al promedio - Las que cuentan con una tasa de éxito muy similar al promedio (+/- 10%) - Las que cuentan con una tasa de éxito entre un 10% y un 50% inferior al promedio - Las que cuentan con una tasa de éxito al menos un 50% inferior al promedio

Creacion de Features

Todo muy lindo, pero qué hago con esto?

El siguiente paso es crear Features basadas en la información que surge de este análisis visual.

Vamos a crear cuatro variables que cuenten la cantidad de palabras claves que aparece en cada línea (según los cuatro grupos predefinidos, excluyendo al grupo de palabras que tienen una tasa de éxito muy similar al promedio).

Se debe tener en cuenta que las variables a crear son a nivel LÍNEA, y no a nivel PALABRA.

Desplegá el código para ver cómo armé las cuatro features!

# Identificando los cuatro grupos de palabras 

# Primero vuelvo a armar el conteo 

 data_tidy  %>% 
   filter(!token %in% stop_words_general) %>%
   group_by(token) %>%
   summarise(n=length(Candidato),
             Prop_exito = mean(Candidato)) -> conteo

 conteo %>% 
   filter(n>=6) -> conteo

 # Luego identifico el grupo de palabras con mayores diferencias respecto a la tasa de éxito promedio
 
 MAYOR_1 <- conteo$token[conteo$Prop_exito>mean(data_tidy$Candidato)*1.75]
 
 MAYOR_0 <- conteo$token[conteo$Prop_exito>mean(data_tidy$Candidato)*1.10]
 MAYOR_0 <- MAYOR_0[!MAYOR_0 %in% MAYOR_1] # Excluyo a los que ya estaban en el primer grupo 
 
 MENOR_1 <- conteo$token[conteo$Prop_exito<mean(data_tidy$Candidato)*0.5]

 MENOR_0 <- conteo$token[conteo$Prop_exito<mean(data_tidy$Candidato)*0.9]
 MENOR_0 <- MENOR_0[!MENOR_0 %in% MENOR_1]

 
 # Por ultimo creo las cuatro features, en el data set que se encuentra a nivel linea
 
 # Primero identifico a cada palabra si se encuentra o no dentro de cada grupo
 
 data_tidy %>%
   mutate(MayorExito_1=ifelse(token %in% MAYOR_1,1,0),
          MayorExito_0=ifelse(token %in% MAYOR_0,1,0),
          MenorExito_1=ifelse(token %in% MENOR_1,1,0),
          MenorExito_0=ifelse(token %in% MENOR_0,1,0)) -> data_tidy
 
 # Luego armo la agregación a nivel linea y candidato. Sumo la cantidad de palabras de cada grupo que aparecen en dicha linea 
 
 data_tidy %>%
   group_by(line,Candidato) %>%
   summarise(MayorExito_1 = sum(MayorExito_1),
             MayorExito_0 = sum(MayorExito_0),
             MenorExito_1 = sum(MenorExito_1),
             MenorExito_0 = sum(MenorExito_0)) -> datos_linea
 
# Listo, ya están creadas las 4 features! En el proximo bloque vamos a mostrar el resumen de lo que armamos

Features

¿Cómo se comporta cada feature?

  • En esta sección se va a analizar cómo es la distribución de las líneas según cada una de las cuatro features creadas, y cómo es la tasa de éxito asociada a cada valor de las variables (poder predictivo).
  • La idea sería encontrar alguna tendencia en las variables creadas que permita diferenciar con mayor precisión las líneas correspondientes al programa de Macri.

Feature 1

Feature 1: Grupos de palabras con mayor tasa de éxito (más de un 75% superior al promedio)

  • Esta variable suma, por línea, la cantidad de veces que aparece alguna de las siguientes palabras:
MAYOR_1
##  [1] "acceso"        "argentina"     "argentinos"    "creemos"      
##  [5] "educacion"     "mejorar"       "nuestro"       "objetivo"     
##  [9] "pais"          "proteccion"    "ser"           "sociales"     
## [13] "transparencia"
  • Agrupando a las líneas que cuentan con dos o más de alguna de esas palabras, se obtiene la siguiente distribución de líneas:
datos_linea  %>%
  mutate(MayorExito_1_Topeada = ifelse(MayorExito_1>2,2,MayorExito_1)) %>%
  group_by(MayorExito_1_Topeada) %>%
  summarise(Cantidad=length(Candidato),
            Tasa_Exito=sum(Candidato)/length(Candidato)) -> resumen

resumen$MayorExito_1_Topeada <- factor(resumen$MayorExito_1_Topeada,
                                       levels=unique(resumen$MayorExito_1_Topeada))

p <- ggplot(resumen, 
            aes(x=MayorExito_1_Topeada, 
                y=Cantidad, 
                fill=MayorExito_1_Topeada)) + 
  geom_bar(stat="identity",
           color = rep('black',3)) + 
  ggtitle("Distribución del total de líneas") + 
  xlab("Feature 1") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))+
  geom_text(aes(label=resumen$Cantidad), position=position_dodge(width=0.9), vjust=-1,size=7)

ggplotly(p)
  • Esto quiere decir que la gran mayoría de las líneas NO contiene ninguna de las palabras del grupo con mayor tasa de éxito (198 de 268 líneas, osea, un 74%).
  • Sin embargo, hay 51 líneas que contienen una de las palabras del grupo, y 19 líneas que contienen al menos dos de las palabras.

Veamos si hay diferencias en las tasas de éxito: 

p <- ggplot(resumen, 
            aes(x=MayorExito_1_Topeada)) + 
  geom_bar(aes(y=Cantidad, 
               fill=MayorExito_1_Topeada),
           stat="identity",
           color = rep('black',3),
           alpha = 0.2) +
   geom_line(aes(y=Tasa_Exito * 198),
             colour=c("#f9bb13"),
             size=1.5,
             group = 1) +
   geom_point(aes(y=Tasa_Exito * 198),
              colour=c("#ff9900"),
              size=2)  +
    geom_text(aes(y=Tasa_Exito * 198,
                  label=paste0(round(resumen$Tasa_Exito,2)*100,"%")),
              position=position_dodge(width=0.9), vjust=-1,size=7) +
  scale_y_continuous(sec.axis = sec_axis(~./198, name = "Tasa de éxito")) +
   theme_minimal() +
  ggtitle("Tasas de éxito según grupos de Feature 1") + 
  xlab("Feature 1") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))

p

  • Efectivamente hay diferencias!
  • Aquellas líneas que cuentan con una de las palabras seleccionadas en este grupo, cuentan con una tasa de éxito un 121% superior respecto de las líneas que no cuentan con ninguna de dichas palabras! (53% vs 24%).
  • Y las líneas que contienen dos o más palabras del grupo cuentan con una tasa de éxito un 271% superior respecto de las líneas que no cuentan con ninguna de dichas palabras (89% vs 24%).
  • Finalmente, si bien se identificaron pocas líneas que contengan las palabras seleccionadas para este grupo, se pueden apreciar amplias diferencias en las tasas de éxito asociadas a cada grupo, lo que indica que la variable puede servir para predecir la probabilidad de que una línea corresponda al programa de Macri.

Feature 2

Feature 2: Grupos de palabras con tasa de éxito entre un 10% y un 75% superior al promedio

  • Esta variable suma, por línea, la cantidad de veces que aparece alguna de las siguientes palabras:
MAYOR_0
##  [1] "anos"          "derecho"       "desarrollo"    "economico"    
##  [5] "equidad"       "estado"        "fortalecer"    "impulsar"     
##  [9] "institucional" "ley"           "politica"      "salud"        
## [13] "seguridad"     "sistema"       "social"
  • Agrupando a las líneas que cuentan con tres o más de alguna de esas palabras, se obtiene la siguiente distribución de líneas:
datos_linea  %>%
  mutate(MayorExito_0_Topeada = ifelse(MayorExito_0>3,3,MayorExito_0)) %>%
  group_by(MayorExito_0_Topeada) %>%
  summarise(Cantidad=length(Candidato),
            Tasa_Exito=sum(Candidato)/length(Candidato)) -> resumen

resumen$MayorExito_0_Topeada <- factor(resumen$MayorExito_0_Topeada,
                                       levels=unique(resumen$MayorExito_0_Topeada))

p <- ggplot(resumen, 
            aes(x=MayorExito_0_Topeada, 
                y=Cantidad, 
                fill=MayorExito_0_Topeada)) + 
  geom_bar(stat="identity",
           color = rep('black',4)) + 
  ggtitle("Distribución del total de líneas") + 
  xlab("Feature 2") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))+
  geom_text(aes(label=resumen$Cantidad), position=position_dodge(width=0.9), vjust=-1,size=7)

ggplotly(p)
  • Esto quiere decir que la mayoría de las líneas contiene al menos una de las palabras de este grupo (156 de 268 líneas).

Veamos si hay diferencias en las tasas de éxito: 

p <- ggplot(resumen, 
            aes(x=MayorExito_0_Topeada)) + 
  geom_bar(aes(y=Cantidad, 
               fill=MayorExito_0_Topeada),
           stat="identity",
           color = rep('black',4),
           alpha = 0.2) +
   geom_line(aes(y=Tasa_Exito * 150),
             colour=c("#f9bb13"),
             size=1.5,
             group = 1) +
   geom_point(aes(y=Tasa_Exito * 150),
              colour=c("#ff9900"),
              size=2)  +
    geom_text(aes(y=Tasa_Exito * 150,
                  label=paste0(round(resumen$Tasa_Exito,2)*100,"%")),
              position=position_dodge(width=0.9), vjust=-1,size=7) +
  scale_y_continuous(sec.axis = sec_axis(~./150, name = "Tasa de éxito")) +
   theme_minimal() +
  ggtitle("Tasas de éxito según grupos de Feature 2") + 
  xlab("Feature 2") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))

p

  • Efectivamente hay diferencias!
  • Aquellas líneas que cuentan con 3 o más de las palabras seleccionadas en este grupo, cuentan con una tasa de éxito un 214% superior respecto de las líneas que no cuentan con ninguna de dichas palabras! (88% vs 21%).

Feature 3

Feature 3: Grupos de palabras con tasa de éxito entre un 10% y un 50% inferior al promedio

  • Esta variable suma, por línea, la cantidad de veces que aparece alguna de las siguientes palabras:
MENOR_0
##  [1] "defensa"  "derechos" "economia" "federal"  "generar"  "mayores" 
##  [7] "mundo"    "nacional" "parte"    "publica"  "recursos" "sociedad"
## [13] "trabajo"
  • Agrupando a las líneas que cuentan con dos o más de alguna de esas palabras, se obtiene la siguiente distribución de líneas:
datos_linea  %>%
  mutate(MenorExito_0_Topeada = ifelse(MenorExito_0>2,2,MenorExito_0)) %>%
  group_by(MenorExito_0_Topeada) %>%
  summarise(Cantidad=length(Candidato),
            Tasa_Exito=sum(Candidato)/length(Candidato)) -> resumen

resumen$MenorExito_0_Topeada <- factor(resumen$MenorExito_0_Topeada,
                                       levels=unique(resumen$MenorExito_0_Topeada))

p <- ggplot(resumen, 
            aes(x=MenorExito_0_Topeada, 
                y=Cantidad, 
                fill=MenorExito_0_Topeada)) + 
  geom_bar(stat="identity",
           color = rep('black',3)) + 
  ggtitle("Distribución del total de líneas") + 
  xlab("Feature 3") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))+
  geom_text(aes(label=resumen$Cantidad), position=position_dodge(width=0.9), vjust=-1,size=7)

ggplotly(p)
  • Esto quiere decir que la mayoría de las líneas no contiene ninguna de las palabras de este grupo (140 de 268 líneas).

Veamos si hay diferencias en las tasas de éxito: 

p <- ggplot(resumen, 
            aes(x=MenorExito_0_Topeada)) + 
  geom_bar(aes(y=Cantidad, 
               fill=MenorExito_0_Topeada),
           stat="identity",
           color = rep('black',3),
           alpha = 0.2) +
   geom_line(aes(y=Tasa_Exito * 150),
             colour=c("#f9bb13"),
             size=1.5,
             group = 1) +
   geom_point(aes(y=Tasa_Exito * 150),
              colour=c("#ff9900"),
              size=2)  +
    geom_text(aes(y=Tasa_Exito * 150,
                  label=paste0(round(resumen$Tasa_Exito,2)*100,"%")),
              position=position_dodge(width=0.9), vjust=-1,size=7) +
  scale_y_continuous(sec.axis = sec_axis(~./150, name = "Tasa de éxito")) +
   theme_minimal() +
  ggtitle("Tasas de éxito según grupos de Feature 3") + 
  xlab("Feature 3") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))

p

  • Efectivamente hay diferencias!
  • Aquellas líneas que cuentan con 3 o más de las palabras seleccionadas en este grupo, cuentan con una tasa de éxito un 84% inferior respecto de las líneas que no cuentan con ninguna de dichas palabras! (7% vs 46%).

Feature 4

Feature 4: Grupos de palabras con tasa de éxito entre al menos un 50% inferior al promedio

  • Esta variable suma, por línea, la cantidad de veces que aparece alguna de las siguientes palabras:
MENOR_1
##  [1] "alianza"       "cambiemos"     "consejo"       "garantizar"   
##  [5] "internacional" "juventudes"    "nuestra"       "nuevo"        
##  [9] "perdida"       "personas"      "poder"         "programa"     
## [13] "promover"      "publicas"      "situacion"
  • Agrupando a las líneas que cuentan con dos o más de alguna de esas palabras, se obtiene la siguiente distribución de líneas:
datos_linea  %>%
  mutate(MenorExito_1_Topeada = ifelse(MenorExito_1>2,2,MenorExito_1)) %>%
  group_by(MenorExito_1_Topeada) %>%
  summarise(Cantidad=length(Candidato),
            Tasa_Exito=sum(Candidato)/length(Candidato)) -> resumen

resumen$MenorExito_1_Topeada <- factor(resumen$MenorExito_1_Topeada,
                                       levels=unique(resumen$MenorExito_1_Topeada))

p <- ggplot(resumen, 
            aes(x=MenorExito_1_Topeada, 
                y=Cantidad, 
                fill=MenorExito_1_Topeada)) + 
  geom_bar(stat="identity",
           color = rep('black',3)) + 
  ggtitle("Distribución del total de líneas") + 
  xlab("Feature 4") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))+
  geom_text(aes(label=resumen$Cantidad), position=position_dodge(width=0.9), vjust=-1,size=7)

ggplotly(p)
  • Esto quiere decir que la mayoría de las líneas no contiene ninguna de las palabras de este grupo (195 de 268 líneas).

Veamos si hay diferencias en las tasas de éxito: 

p <- ggplot(resumen, 
            aes(x=MenorExito_1_Topeada)) + 
  geom_bar(aes(y=Cantidad, 
               fill=MenorExito_1_Topeada),
           stat="identity",
           color = rep('black',3),
           alpha = 0.2) +
   geom_line(aes(y=Tasa_Exito * 150),
             colour=c("#f9bb13"),
             size=1.5,
             group = 1) +
   geom_point(aes(y=Tasa_Exito * 150),
              colour=c("#ff9900"),
              size=2)  +
    geom_text(aes(y=Tasa_Exito * 150,
                  label=paste0(round(resumen$Tasa_Exito,2)*100,"%")),
              position=position_dodge(width=0.9), vjust=-1,size=7) +
  scale_y_continuous(sec.axis = sec_axis(~./150, name = "Tasa de éxito")) +
   theme_minimal() +
  ggtitle("Tasas de éxito según grupos de Feature 4") + 
  xlab("Feature 4") + ylab("Cantidad de líneas") +
  theme_minimal() +
  theme(axis.text.x = element_text(size=15,face = "bold"),
         axis.title.x = element_text(size=15),
         axis.title.y = element_text(size=15),
         plot.title = element_text(color = "gray43", size = 15, face = "bold",hjust=0.5))

p

  • Efectivamente hay diferencias!
  • Aquellas líneas que cuentan con 2 o más de las palabras seleccionadas en este grupo, cuentan con una tasa de éxito del 0%.

Correlación

Análisis de correlación entre Features

  • A continuación vamos a realizar un estudio de correlación entre Features, para entender qué tan relacionadas se encuentran las variables construidas hasta el momento, y si contienen o no información redundante.
  • Se van a presentar dos maneras distintas de mostrar correlación entre variables.

Visualizacion 1

# Defino el data set unicamente con las features a analizar 
mydata <- datos_linea[,3:ncol(datos_linea)]

# Grafico 1
library(corrplot)
corrplot.mixed(cor(mydata), order="hclust", tl.col="black")

Visualizacion 2

# Defino el data set unicamente con las features a analizar 
mydata <- datos_linea[,3:ncol(datos_linea)]

# Grafico 2
library(GGally)
ggpairs(mydata)

Conclusion

  • Ninguna de las 4 variables cuenta con alta correlación con otra variable, por lo que en principio no habría problema de redundancia de información si se pretendiera desarrollar un modelo con estas features.

Siguientes pasos

Bueno, y cómo sigo?

  • Lo que tenemos ahora es un data set a nivel línea, con 4 features creadas y un FLAG a predecir (en este caso es la columna “Candidato”, que indica de si se trata del programa de Macri), que tiene la siguiente estructura:
library(DT)
datatable(datos_linea)

  • Siguiendo esta línea se podrían crear cientos de features más que ayuden a discriminar entre un programa de Macri vs un programa de Fernandez!

  • Finalmente, cuando se crearon suficientes features, se puede correr algún algoritmo de Machine Learning para optimizar la combinación de estas features y obtener las mejores predicciones posibles para el evento objetivo.

Conclusiones

Conclusiones y puntos interesantes a profundizar

  • Cuando se hace un análisis de text mining con el objetivo de crear distintas features para armar un modelo predictivo, es importante no perder de vista qué es lo que quiero predecir y cómo puedo construir variables que dependan de palabras o relaciones de palabras tal que ayuden a mejorar las predicciones.

  • Así como en este trabajo se hizo un análisis de palabras y la tasa de éxito asociada a cada una de ellas, se puede realizar algún tipo de análisis entre relaciones de palabras, siguiendo la misma metodología.

  • Las 4 features creadas en este trabajo se resumen en el siguiente grafo, en donde se puede ver qué palabras se consideran para definir cada uno de los grupos:

Resumen_Features <- data.frame(FEATURE=c(rep("MayorExito_1",length(MAYOR_1)),
                                         rep("MayorExito_0",length(MAYOR_0)),
                                         rep("MenorExito_1",length(MENOR_1)),
                                         rep("MenorExito_0",length(MENOR_0))),
                               PALABRAS=c(MAYOR_1,
                                          MAYOR_0,
                                          MENOR_1,
                                          MENOR_0))

nivel_1 <- length(unique(Resumen_Features$FEATURE))
nivel_2 <- length(unique(paste(Resumen_Features$FEATURE,Resumen_Features$PALABRAS)))

p <- collapsibleTree(Resumen_Features, 
                     root="Features",
                     hierarchy = c("FEATURE", "PALABRAS"),
                     fontSize = 12,
                     fill = c("hotpink",
                              rep("plum", nivel_1),
                              rep("lightskyblue",nivel_2)),
                     collapsed = TRUE,
                     tooltip=TRUE,
                     zoomable = TRUE,
                     fillByLevel=TRUE)
p

  • Si alguien tiene otras ideas para aportar, serán muy bien recibidas!

  • Muchas gracias por leerme hasta acá :)