Caso de estudio 3 + Caso de estudio 4

En este documento se realizara una serie del tiempo para analizar y comparar el estado de animo de las personas en méxico con base a sus tweets, y ver como este a cambiado respecto a la pandemia más reciente.

Imagen representativa

Importar datos

library(pacman, tidyverse)

p_load("base64enc", "htmltools", "mime", "xfun", "prettydoc","readr", "knitr","DT","dplyr", "ggplot2","plotly", "gganimate","gifski","scales","datasets","fdth", "GGally", "gridExtra","corrplot")
tweets <- read_csv("datos_twitter.csv")
## Rows: 2255 Columns: 7
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr  (2): tipo_usuario, lugar
## dbl  (4): tuits_negativos, indice, recoleccion_promedio, tuits_positivos
## date (1): fecha
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.
datatable(tweets)
tuitsAntesNegativos= ts(tweets[2], start = c(2016), end = c(2020), frequency = 12)
tuitsAntesNegativos
##        Jan   Feb   Mar   Apr   May   Jun   Jul   Aug   Sep   Oct   Nov   Dec
## 2016 34401 34689 39431 46229 44575 43144 42547 46027 38919 40552 48545 43537
## 2017 47347 47837 39033 38003 40682 43126 41019 41634 39618 38079 34354 40478
## 2018 42117 41156 41919 40741 37697 35741 36328 41179 39212 40859 34781 27802
## 2019 35124 42267 38856 39781 39921 39653 38781 37918 39535 41594 40646 40679
## 2020 40914
tuitsAntesPositivos= ts(tweets[7], start = c(2016), end = c(2020), frequency = 12)
tuitsAntesPositivos
##         Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
## 2016 102401  87432  94997 109772 100176  99458  96080 101565 100065  96689
## 2017  96110 100735  96099  95216  99796  92845  91236  92049  91049  92008
## 2018  92564  91793  94864  95124  97175  93764  95785  98240  92347  95664
## 2019  92330 106284  95356  96370 102481 101153 106535 103034 107637  97946
## 2020  94602                                                               
##         Nov    Dec
## 2016  97004  91623
## 2017  87731  96211
## 2018  83783  75733
## 2019  92341  94491
## 2020
tuitsDespuesNegativos= ts(tweets[2], start = c(2020), end = c(2022), frequency = 12)
tuitsDespuesNegativos
##        Jan   Feb   Mar   Apr   May   Jun   Jul   Aug   Sep   Oct   Nov   Dec
## 2020 34401 34689 39431 46229 44575 43144 42547 46027 38919 40552 48545 43537
## 2021 47347 47837 39033 38003 40682 43126 41019 41634 39618 38079 34354 40478
## 2022 42117
tuitsDespuesPositivos= ts(tweets[7], start = c(2020), end = c(2022), frequency = 12)
tuitsDespuesPositivos
##         Jan    Feb    Mar    Apr    May    Jun    Jul    Aug    Sep    Oct
## 2020 102401  87432  94997 109772 100176  99458  96080 101565 100065  96689
## 2021  96110 100735  96099  95216  99796  92845  91236  92049  91049  92008
## 2022  92564                                                               
##         Nov    Dec
## 2020  97004  91623
## 2021  87731  96211
## 2022

Tweets Negativos antes de la pandemia

plot(tuitsAntesNegativos, main ="Tweets negativos antes de la pandemia", xlab="fecha", ylab="Tweets negativos")

En la gráfica anterior se puede observar que varía mucho el número de tweets negativos.

Tweets Negativos después de la pandemia

plot(tuitsDespuesNegativos, main ="Tweets negativos después de la pandemia", xlab="fecha", ylab="Tweets negativos")

Después de la pandemia se puede observar que aunque hay momentos de caídas drásticas, al inicio si hubieron picos muy altos con respecto a tweets negativos.

Tweets Positivos antes de la pandemia

plot(tuitsAntesPositivos, main ="Tweets positivos antes de la pandemia", xlab="Año", ylab="Tweets positivos")

Se puede observar que el número de tweets positivos antes de la pandemia era un poco variante pero pero mayormente se mantenía en la misma cantidad, a excepción de la abrupta caída de 2019.

Tweets Positivos después de la pandemia

plot(tuitsDespuesPositivos, main ="Tweets positivos después de la pandemia", xlab="Año", ylab="Tweets positivos")

Después de la pandemia el número de tweet positivos fueron decayendo conforme avanzaba la situación, y aunque es verdad que es similar a la cantidad de tweets positivos antes de la pandemia se alcanza a notar que los ánimos fueron decayendo poco a poco.

Caso de estudio 4

Introducción

Desde hace un par de años vivimos en una realidad a la cual nadie se había preparado y mucho menos acostumbrado, la pandemia de COVID-19 causo un gran cambio en muchos de los aspectos de las personas, incluyendo su estado de animo y manera de pensar. Cada persona reacciona de diferente manera ante los sucesos que se hacen públicos en las redes sociales y los medios, por lo que de igual manera se expresan diferentes opiniones a la hora de hablar de la pandemia.

A continuación se hará un análisis de la relación entre la cantidad de decesos por COVID-19, el radio de movilidad de las personas y el índice del estado de animo (positivismo) de los tuiteros, utilizando los datos respectivos al año 2020.

Imagen representativa

Teoría

Lo que se propone es analizar la relación entre las variables mencionadas y deducir si el aumento en la cantidad de decesos tiene un efecto (ya sea positivo o negativo) en el índice (el índice siendo la relación de los tuits positivos con los negativos de manera que índice = positivos / negativos) del estado de animo, al igual que en la movilidad de las personas de México en el año 2020.

Datos utilizados

Datos de decesos por COVID-19

Estos datos son obtenidos del taller de ciencia de datos aplicada a salud pública y epidemiología, que a su vez obtiene directamente los datos en crudo del repositorio GitHub, estos datos nos muestran los decesos por COVID durante la pandemia.

url_decesos <- "https://raw.githubusercontent.com/CSSEGISandData/COVID-19/master/csse_covid_19_data/csse_covid_19_time_series/time_series_covid19_deaths_global.csv"

datos_decesos <- read.csv(url_decesos)

Datos de movilidad regional en 2020

Estos datos fueron obtenidos de la página de Google:https://www.google.com/covid19/mobility/, la cual proporciona informes de movilidad que se desglosan por ubicación y muestran cómo ha cambiado el número de visitas a distintos lugares.

datos_movilidad <- read.csv("2020_MX_Region_Mobility_Report.csv")

Datos del estado de ánimo segun Tweets

Estos datos fueron obtenidos de la página de INEGI: https://www.inegi.org.mx/app/animotuitero/#/app/multiline, la cual mediante el uso de mecanismos que Twitter pone a disposición, este organismo ha recolectado tuits públicos y georrefenciados dentro del país.

datos_tweets <- read_csv("datos_twitter.csv")
## Rows: 2255 Columns: 7
## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr  (2): tipo_usuario, lugar
## dbl  (4): tuits_negativos, indice, recoleccion_promedio, tuits_positivos
## date (1): fecha
## 
## i Use `spec()` to retrieve the full column specification for this data.
## i Specify the column types or set `show_col_types = FALSE` to quiet this message.

Definición de variables

decesos <- t(datos_decesos[datos_decesos$Country.Region=="Mexico" ,])
movilidad <- datos_movilidad
tuits <- datos_tweets

Formatear datos

#vector de fecha
Fecha <- seq(from = as.Date("2020-02-15"), to = as.Date("2020-12-31"), by = "day")

#decesos 
vec1 <- as.vector(decesos)
vec2 <- vec1[29:349]
num1 <- as.numeric(vec2)
Decesos <- as.vector(num1)

#movilidad
vec1 <- as.vector(movilidad$residential_percent_change_from_baseline)
vec2 <- vec1[1:321]
num1 <- as.numeric(vec2)
Movilidad <- as.vector(num1)

#índice de estado de animo
vec1 <- as.vector(tuits$indice)
vec2 <- vec1[1505:1825]
num1 <- as.numeric(vec2)
Positivismo <- as.vector(num1)

Generación de data frame y Graficación de datos

datos1 <- data.frame(Fecha, Decesos, Movilidad, Positivismo)

gcov <- ggplot(data = datos1) +
  geom_line(aes(Fecha, Decesos, colour="Decesos")) +
  geom_line(aes(Fecha, Movilidad, colour="Movilidad")) +
  geom_line(aes(Fecha, Positivismo, colour="Positivismo")) +
  xlab("Fecha") +
  ylab("Cantidad") +
  labs(colour="casos")+
  ggtitle("Gráfica con los 3 datos a la vez") +
  scale_y_continuous(labels = comma)
gcov

Gráfica interactiva

ggplotly(gcov)

Gráfica animada

ggplot(data = datos1) +
  geom_line(aes(Fecha, Decesos, colour="Decesos")) +
  geom_line(aes(Fecha, Movilidad, colour="Movilidad")) +
  geom_line(aes(Fecha, Positivismo, colour="Positivismo")) +
  xlab("Fecha") +
  ylab("Cantidad") +
  labs(colour="casos")+
  ggtitle("Gráfica con los 3 datos a la vez") +
  scale_y_continuous(labels = comma) +
  transition_reveal(Fecha)

Análisis de correlación

datos_rel <- data.frame(Decesos, Movilidad, Positivismo)
round(cor(x = datos_rel, method = "pearson"), 3)
##             Decesos Movilidad Positivismo
## Decesos       1.000    -0.160       0.774
## Movilidad    -0.160     1.000      -0.186
## Positivismo   0.774    -0.186       1.000
ggpairs(datos_rel, lower = list(continuous ="smooth"),
        diag = list (continuos = "barDiag"), axisLabels = "none")

Matriz de correlación

corrplot(cor(dplyr::select(datos_rel, Decesos, Movilidad, Positivismo)),
         method = "number", tl.col = "black")

Tomando como referencia la matriz de correlación basada en el análisis, se puede apreciar que si bien la variable de decesos no tiene una relación perfecta con el índice de estado de animo sigue siendo bastante fuerte, con la característica que de que es un valor positivo, indicando que es una relación proporcional (a mayores decesos, mayor índice).

Conclusión

Una vez vistas las relaciones entre las variables dadas por los diagramas y los cálculos se podría decir que existe una cierta relación entre los decesos y el índice de estado de animo, de tal manera que entre más decesos había, aumentaba el índice, es decir que era una relación proporcional.

Esto podria indicar que los decesos implicaron un aumento en la cantidad de tuits positivos, sin embargo existen otros factores que podrían ser más significativos para la teoria, como el uso de otras redes sociales en las cuales se pueden expresas los usuarios.

Descarga este código

xfun::embed_file("A9U1.Rmd")

Download A9U1.Rmd