Examen Análisis de Datos

Análisis de datos de encuesta.

Establezco el directorio de trabajo y activo las librerías a utilizar.

knitr::opts_chunk$set(warning = FALSE, message = F) 
setwd("C:/Users/ruben/Desktop/Examen")
library(RCurl)
library(stringr)
library(ROAuth)
library(rtweet)
library(dplyr)
library(tidyverse)
library(haven)
library(car)
library(devtools)
library(readxl)
library(tm) 
library(tidytext)
library(data.table)
library(ggplot2)
library(igraph)
library(wordcloud)
library(knitr)
library(RColorBrewer)
library(quanteda)
library(units)
library(ggraph)
library(stringi)
library(plotly)
library(wordcloud2)
library(devtools)

Establezco el documento que contiene nuestro dataframe:

data<-read_dta("CIS3223.dta")

Limpio las variables a utilizar:

data$P23
data$ideol<-data$P23
data$ideol[data$ideol>10]<-NA


data$P30
data$hombre<-data$P30
data$hombre[data$hombre==2]<-0
val_labels(data$hombre)<-c(Mujer=0, Hombre=1)


data$P31
data$edad<-data$P31


data$P33
data$religion<-data$P33
data$religion[data$religion>4]<-NA
data$religion[data$religion>=3 & data$religion<=4]<-2
data$ingresos <- factor(data$ingresos,
                            levels = c(1,2),
                            labels = c("Católico", "No católico") 
                                       
data$P41
data$ingresos<-data$P41
data$ingresos[data$ingresos>11]<-NA
data$ingresos[data$ingresos>=1 & data$ingresos<=4]<-1
data$ingresos[data$ingresos>=5 & data$ingresos<=8]<-2
data$ingresos[data$ingresos>=9 & data$ingresos<=11]<-3
data$ingresos <- factor (data$ingresos,
                            levels = c(1,2,3),
                            labels = c("Clase Baja", "Clase Media", "Clase Alta")) 

data$P14
data$reforma<-data$P14
data$reforma[data$reforma>8]<-NA
data$reforma[data$reforma==8]<-3
data$reforma <- factor (data$reforma,
                            levels = c(1,2,3),
                            labels = c("Reformarla", "Dejarla", "Duda")) 

Me quedo con las variables más interesantes para nuestro análisis y elimino el dataframe original:

myvars <- c("ideol", "hombre", "edad", "religion", "ingresos","reforma")
cis<-data[myvars]
cis<- na.omit(cis)
dim(cis)

remove(data)

Una vez he realizado la limpieza de las variables a utilizar y he limpiado el dataframe, procedo a continuación a realizar la regresión:

m.reforma <- glm(reforma ~ ideol + hombre + edad + religion + ingresos, data = cis, family = "binomial")
summary(m.logit)

El resultado de realizar la regresión nos muestra que las variables que son estadísticamente significativas son:

• Ideología, al 99,9% de confianza. Implica que según un individuo se identifica más a la derecha, su probabilidad de estar en contra de reformar la Constitución aumenta en 0,218011.
• Edad, al 95% de confianza. Implica que según un individuo crece un año en edad, su probabilidad de estar en contra de reformar la Constitución aumenta en 0,008057.
• Religión, al 99,9% de confianza. Implica que el hecho de no ser católico respecto a serlo, disminuye la probabilidad de querer mantener la Constitución sin mácula (aumenta el apoyo a la reforma) en -0.626923.
• Ser de clase media respecto a ser de clase baja, al 99,9% de confianza. Implica que un individuo de clase media tiene una probabilidad de -0,634797 menos de estar en contra de reformar la Constitución respecto a uno de clase baja.

Ahora expresaré los odds ratio de la regresión para ver de forma más clara qué variables aumentan o disminuyen la probabilidad de apoyar la reforma o el statu quo:

exp(cbind(OR = coef(m.reforma)))

En este caso, parecen tener un efecto positivo sobre querer mantener el statu quo las variables de ideología (en 1,24 veces más), el género masculino sobre el femenino (en 1,03) y la edad (en 1,008). Y parecen tener un efecto negativo sobre la preferencia de mantener el statu quo el no ser católico (en un 47%), la clase media frente a la baja (en un 48%) y la clase alta frente a la baja (en un 51%).

Para completar mi análisis voy a realizar una visualización gráfica de los efectos marginales de las variables analizadas:

margins_reforma <- margins(m.reforma)
summary(margins_reforma)

plot(margins_reforma, main="Preferencia sobre reforma constitucional", col.main="blue", pch=12, las=2, labels=c(
"Ideología", "Hombre", "Edad", "Religión", "Clase media", "Clase Alta"))

A continuación hago un stargazer para únicamente poder exportar la tabla en formato científico en caso de que me interese:

stargazer(m.reforma,
type="text",
dep.var.labels=c("Reforma constitucional"),
covariate.labels=c("Ideología", "Hombre", "Edad", "Religión", "Clase media", "Clase Alta"))

Análisis de datos no estructurados.

tweets<-read.csv("tweets_examen.csv", header = T)

Limpieza de tweets

Debido a que los tweets tienen emoticonos, hipervínculos, hashtags y otros elementos distintos a palabras, procedo a limpiarlos. Empezaré por decodificar los emoticonos:

tweets <- data.frame(text = iconv(tweets$text, "latin1", "ASCII", "byte"), stringsAsFactors = FALSE)

Continuaré con la limpieza de tweets mediante la función limpiar.tweets, con lo que haré desaparecer símbolos, palabras cortas, sustituyendo mayúsuculas por minúsculas y otros elementos indeseables para este análisis.

limpiar.tweets <- function(some_txt)
{
  some_txt = gsub("(RT|via)((?:\\b\\W*@\\w+)+)", "", some_txt)
  some_txt = gsub("@\\w+", "", some_txt)
  some_txt = gsub("[[:punct:]]", "", some_txt)
  some_txt = gsub("[[:digit:]]", "", some_txt)
  some_txt = gsub("http\\w+", "", some_txt)
  some_txt = gsub("[ \t]{2,}", "", some_txt)
  some_txt = gsub("^\\s+|\\s+$", "", some_txt)
  some_txt = gsub("amp", "", some_txt)
  some_txt = gsub('\\b\\w{1,3}\\b','', some_txt)
  some_txt = gsub("[^\x01-\x7F]", "", some_txt)
  some_txt = gsub('\\p{So}|\\p{Cn}', '', some_txt, perl = TRUE)
   try.tolower = function(x)
  {
    y = NA
    try_error = tryCatch(tolower(x), error=function(e) e)
    if (!inherits(try_error, "error"))
      y = tolower(x)
    return(y)
  }
  some_txt = sapply(some_txt, try.tolower)
  names(some_txt) = NULL
  return(some_txt)
}

Una vez definida la función de limpieza de texto, la aplico a la columna del dataframe que contiene el texto de los tweets:

tweets_limpios <- limpiar.tweets(tweets$text)

A continuación, procedo a crear un corpus de palabras, del que eliminaré las stopwords, los espacios en blanco y otros símbolos. Además, me quedo solo con la raíz de las palabras:

signos<-c("t.co", "https", "rt", "rts", "http", "...")
corpus_tweets <- Corpus(VectorSource(tweets$text)) %>%
  tm_map(removePunctuation) %>% 
  tm_map(removeNumbers) %>%     
  tm_map(tolower)  %>%          
  tm_map(removeWords, stopwords("english")) %>%   
  tm_map(removeWords, signos) %>%
  tm_map(stripWhitespace) 

Para comprobar que los tweets se han limpiado bien, visualizo los cinco primeros:

for (i in 1:5) {
  cat(paste("[[", i, "]] ", sep = ""))
  writeLines(as.character(corpus_tweets[[i]]))
}

A continuación, elimino del corpus todas las palabras que aparecen con muy poca frecuencia, menos del 0,1% de las veces, y creo el dataframe para empezar el análisis:

tf_tweets <- DocumentTermMatrix(corpus_tweets)  
tf_tweets <- removeSparseTerms(tf_tweets, .999)
tf_tweets <- as.matrix(tf_tweets)
tf_tweets<- as.data.frame(tf_tweets)
dim(tf_tweets)

Análisis exploratorio de las palabras contenidas en el corpus

Procedo a crear, en primer lugar, una nube de palabras con las palabras más frecuentes en nuestro corpus y después, con los hastags más frecuentes:

word.freq <- colSums(tf_tweets)   
word.freq <- data.frame(word = names(word.freq), freq = word.freq)  
rownames(word.freq) <- NULL
head(word.freq[order(-word.freq$freq),], 10)
wordcloud2(data=word.freq, rotateRatio = .15)

word.freq <- (word.freq[order(-word.freq$freq),][1:25,])
word.freq$word <- factor(word.freq$word, levels = word.freq$word[order(-word.freq$freq )])

ggplot(word.freq,aes(word, freq)) +
  geom_bar(stat = "identity", color = "black", fill = "forestgreen") +
  geom_text(aes(hjust = -0.1, label = freq), size=3) + 
  coord_flip() + 
  labs(title = "25 términos más frecuentes",  x = "Palabras", y = "Frecuencia")

Observando los términos más frecuentes del corpus puedo tratar de imaginar que el tema escogido para la minería de datos en Twitter de la que procede el corpus que me hallo analizando fue el de la reciente decisión de Íñigo Errejón de concurrir a las elecciones autonómicas de Madrid con una marca distinta a la de PODEMOS. Continúo con el análisis.

hastag.freq <- colSums(tf_tweets)   
hastag.freq <- data.frame(word = names(hastag.freq), freq = hastag.freq)
rownames(hastag.freq) <- NULL
head(word.freq[order(-hastag.freq$freq),], 10)
wordcloud2(data=hastag.freq, rotateRatio = .15)
hastag <- DocumentTermMatrix(corpus_tweets)
hastag <- removeSparseTerms(hastag, .98) 
hastag <- as.matrix(hastag)
hastag <- as.data.frame(hastag)

Hagor otro grafo de barras para observar cuáles son los hastags mñas frecuentes dentro del corpus:

hashtag <- Corpus(VectorSource(ht)) %>%
  tm_map(removePunctuation) %>% 
  tm_map(removeNumbers) %>%     
  tm_map(tolower)  %>%          
  tm_map(removeWords, stopwords("english")) %>%   
  tm_map(removeWords, signos) %>%  
  tm_map(stripWhitespace) 

hastag.freq <- (hastag.freq[order(-hastag.freq$freq),][1:10,])
hastag.freq$word <- factor(hastag.freq$word, levels = hastag.freq$word[order(-hastag.freq$freq )])

ggplot(hastag.freq,aes(word, freq)) +
  geom_bar(stat = "identity", color = "black", fill = "forestgreen") +
  geom_text(aes(hjust = -0.1, label = freq), size=3) + 
  coord_flip() + 
  labs(title = "10 términos más frecuentes",  x = "Hastags", y = "Frecuencia")