CE4_Estadística
library(pacman)
p_load("tidyr", "ggfortify", "tseries", "DT", "base64enc", "htmltools", "mime", "xfun", "prettydoc","readr", "knitr","DT","dplyr", "ggplot2","plotly", "gganimate","gifski","scales","datasets","fdth", "GGally", "gridExtra","corrplot")Animo de los twitteros de México antes y después del COVID
Introducción
Uno de los principales factores de cambio que se vieron afectados con la llegada de la pandemia y la nueva normalidad es el estado de animo de las personas, el confinamiento social fue algo que impacto en la salud mental de toda la población mundial.
Nuestro país no fue la excepción en este patrón, el estado de ánimo de los mexicanos también fue fluctuante antes de pandemia, durante pandemia e incluso ahora que recientemente se está empezando a regresar a la normalidad, la cual no creo que vaya a ser igual que antes, por lo menos no en un largo tiempo, por eso le llamamos nueva normalidad.
Esta variable resulta curiosa de analizar al momento de tratar de entender el comportamiento de las masas en el ámbito emocional o de estado de ánimo, percatarse de los puntos de inflexión que dieron pie a cambios de estados de ánimo en la población, tratar identificar eventos que fueron parteaguas en este tipo de factores, evento como lo es la pandemia.
La información proveniente de sistemas en Internet y de dispositivos electrónicos conectados a esta red, puede contribuir en la producción de información estadística y geográfica, razón por la cual Organismos Internacionales y Oficinas Nacionales de Estadística de varios países, entre ellas el Instituto Nacional de Estadística y Geografía (INEGI), están incursionando en aplicaciones prácticas de Ciencia de Datos destinadas a resolver problemas de Big Data, en particular usando información proveniente de dispositivos móviles explorando la factibilidad de generar estadísticas de movilidad y turismo; de búsquedas web relacionándolas con estadísticas laborales, de sitios de comercio electrónico para estadísticas de precios, y de redes sociales para confianza del consumidor, entre otras aplicaciones.
Análisis de series de tiempo
Para este análisis de serie de tiempo utilizaremos los datos de tweets en México, Twitter es una red social en la que los usuarios escriben textos cortos de hasta 140 caracteres que quedan visibles públicamente, es decir cualquier persona puede leer lo que se escribe en Twitter, no solamente aquellos que están vinculados al usuario que escribió el tuit. Adicionalmente el tuitero tiene la alternativa de georreferenciar sus tuits, etiquetando cada tuit con las coordenadas geográficas de su ubicación en el momento de publicarlo. El análisis del ánimo de los tuiteros se centró en estos tuits georreferenciados, debido a que es posible descargarlos mediante filtros geográficos sin importar el tema del que hable el tuitero, la desventaja de esto es que no todos los tuits se emiten con el atributo geográfico.
- ¿Que es una serie de tiempo?
Una serie de tiempo es un conjunto de observaciones sobre los valores que toma una variable (cuantitativa) a través del tiempo. Por tanto, una serie de tiempo es una forma estructurada de representar datos. Los datos se pueden comportar de diferentes maneras a través del tiempo: puede que se presente una tendencia, estacionalidad o simplemente no presenten una forma definida.
- ¿Que es una ciclo?
Son largas desviaciones de la tendencia debido a factores diferentes de la estacionalidad. Los ciclos por lo general se producen durante un intervalo de tiempo extenso, y los tiempos que transcurren entre los picos o valles sucesivos de un ciclo no necesariamente son iguales.
- Datos de estado de ánimo de los tuiteros en México: https://www.inegi.org.mx/app/animotuitero/#/app/multiline
Mediante el uso de mecanismos que Twitter pone a disposición de cualquier usuario, el INEGI ha recolectado tuits públicos y georreferenciados dentro del territorio nacional, la parte sur de los Estados Unidos de América y norte de Centroamérica. Las siguientes dos gráficas muestran visualmente, gracias a su atributo de georreferenciación, todos los tuits recolectados por INEGI entre febrero de 2014 y mayo de 2015. Cada punto azul es un tuit público y georreferenciado, publicado entre febrero de 2014 hasta el 15 de mayo de 2015 (125 millones de tuits) que, en conjunto delinean la República Mexicana y sus principales vías de comunicación.
Importamos datos
library(readr)
animoMX <- read_csv("data.csv") # Importamos datos## 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(animoMX)Para tratar este vector numérico como una serie de tiempo, se utilizará el comando ts (time-series objects).
animoMX.ts <- ts(animoMX, start = c(2019,1), end = c(2022,1), frequency = 12 )frequency = 12 meses es un año (un ciclo)
start = inicio enero de 2019
print(animoMX.ts)## fecha tuits_negativos indice recoleccion_promedio tipo_usuario lugar
## Jan 2019 16801 34401 2.976687 136802 1 1
## Feb 2019 16802 34689 2.520453 122121 1 1
## Mar 2019 16803 39431 2.409196 134428 1 1
## Apr 2019 16804 46229 2.374527 156001 1 1
## May 2019 16805 44575 2.247358 144751 1 1
## Jun 2019 16806 43144 2.305257 142602 1 1
## Jul 2019 16807 42547 2.258209 138627 1 1
## Aug 2019 16808 46027 2.206640 147592 1 1
## Sep 2019 16809 38919 2.571109 138984 1 1
## Oct 2019 16810 40552 2.384321 137241 1 1
## Nov 2019 16811 48545 1.998228 145549 1 1
## Dec 2019 16812 43537 2.104486 135160 1 1
## Jan 2020 16813 47347 2.029907 143457 1 1
## Feb 2020 16814 47837 2.105797 148572 1 1
## Mar 2020 16815 39033 2.461994 135132 1 1
## Apr 2020 16816 38003 2.505486 133219 1 1
## May 2020 16817 40682 2.453075 140478 1 1
## Jun 2020 16818 43126 2.152878 135971 1 1
## Jul 2020 16819 41019 2.224238 132255 1 1
## Aug 2020 16820 41634 2.210909 133683 1 1
## Sep 2020 16821 39618 2.298173 130667 1 1
## Oct 2020 16822 38079 2.416240 130087 1 1
## Nov 2020 16823 34354 2.553735 122085 1 1
## Dec 2020 16824 40478 2.376871 136689 1 1
## Jan 2021 16825 42117 2.197782 134681 1 1
## Feb 2021 16826 41156 2.230367 132949 1 1
## Mar 2021 16827 41919 2.263031 136783 1 1
## Apr 2021 16828 40741 2.334847 135865 1 1
## May 2021 16829 37697 2.577791 134872 1 1
## Jun 2021 16830 35741 2.623430 129505 1 1
## Jul 2021 16831 36328 2.636671 132113 1 1
## Aug 2021 16832 41179 2.385682 139419 1 1
## Sep 2021 16833 39212 2.355070 131559 1 1
## Oct 2021 16834 40859 2.341320 136523 1 1
## Nov 2021 16835 34781 2.408873 118564 1 1
## Dec 2021 16836 27802 2.724013 103535 1 1
## Jan 2022 16837 35124 2.628687 127454 1 1
## tuits_positivos
## Jan 2019 102401
## Feb 2019 87432
## Mar 2019 94997
## Apr 2019 109772
## May 2019 100176
## Jun 2019 99458
## Jul 2019 96080
## Aug 2019 101565
## Sep 2019 100065
## Oct 2019 96689
## Nov 2019 97004
## Dec 2019 91623
## Jan 2020 96110
## Feb 2020 100735
## Mar 2020 96099
## Apr 2020 95216
## May 2020 99796
## Jun 2020 92845
## Jul 2020 91236
## Aug 2020 92049
## Sep 2020 91049
## Oct 2020 92008
## Nov 2020 87731
## Dec 2020 96211
## Jan 2021 92564
## Feb 2021 91793
## Mar 2021 94864
## Apr 2021 95124
## May 2021 97175
## Jun 2021 93764
## Jul 2021 95785
## Aug 2021 98240
## Sep 2021 92347
## Oct 2021 95664
## Nov 2021 83783
## Dec 2021 75733
## Jan 2022 92330animoMX2.ts<-ts(animoMX[,"tuits_negativos"], start=c(2019,1), end = c(2022,1), frequency= 12) # Grafica de tweets negativos.
animoMX3.ts<-ts(animoMX[,c(2,7)], start=c(2018), end = c(2022), frequency= 12) # Serie de tiempo de cada una de las variables.Ahora que la variable es un objeto orientado a tiempo, se puede hacer una gráfica en la cual se entienda la periodicidad de los tweets negativos.
plot(animoMX.ts)
plot(animoMX3.ts)
En este conjunto de graficas muestra la evolución de las variables desde finales de 2019, esto con la finalidad de que se relacionar los picos de crecimiento de cada una de las variables con respecto a la negatividad y positividad de los tweets y forjar una idea de los factores que influyen más o influyen menos en los tweets, según que picos de cada variable coincide con eventos que sucedieron en esas fechas en la que se registra el incremento dentro de la serie de tiempo.
plot(animoMX2.ts)
En esta grafica se recalca más los picos de tweets negativos, haciendo énfasis en esa grafica en específico para alcanzar a apreciar los lapsos en los que se generan los picos de manera detallada.
Antes y Después del confinamiento
Para hacer una comparación de la brecha entre la naturaleza de los tweets antes y después, haremos una comparación de los tweets negativos antes y después de la pandemia, así mismo será con los tweets positivos.
pos_PreCovid= ts(animoMX[7], start = c(2018), end = c(2020), frequency = 12) # Tweets positivos antes de la llegada del COVID.
pos_PostCovid= ts(animoMX[7], start = c(2020), end = c(2022), frequency = 12) # Tweets positivos despues de la llegada del COVID.neg_PreCovid= ts(animoMX[2], start = c(2016), end = c(2020), frequency = 12)
autoplot(neg_PreCovid, ts.colour = "red")
Tweets negativos antes del confinamiento.
neg_PostCovid= ts(animoMX[2], start = c(2020), end = c(2022), frequency = 12)
autoplot(neg_PostCovid, ts.colour = "red")
Tweets negativos después del confinamiento.
pos_PreCovid= ts(animoMX[7], start = c(2016), end = c(2020), frequency = 12)
autoplot(pos_PreCovid, ts.colour = "green")
Tweets positivos antes del confinamiento.
pos_PostCovid= ts(animoMX[7], start = c(2020), end = c(2022), frequency = 12)
autoplot(pos_PostCovid, ts.colour = "green")
Tweets positivos después del confinamiento.
decesos <- read_csv("time_series_covid19_deaths_global.csv")## Rows: 284 Columns: 788## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (2): Province/State, CountryRegion
## dbl (786): Lat, Long, 1/22/20, 1/23/20, 1/24/20, 1/25/20, 1/26/20, 1/27/20, ...##
## 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.decesosMX <- t(decesos[decesos$CountryRegion=="Mexico" ,])
Fecha <- seq(from = as.Date("2020-02-15"), to = as.Date("2020-12-31"), by = "day" )
vec1 <- as.vector(decesosMX)
vec2 <- vec1[29:349]
num1 <- as.numeric(vec2)
Decesos <- as.vector(num1)
datosdedecesos <- data.frame(Fecha, Decesos)
datatable(datosdedecesos)Decesos en México en 2020 a causa de Covid19
movilidadMX <- read_csv("2020_MX_Region_Mobility_Report.csv")## Rows: 10593 Columns: 15## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (6): country_region_code, country_region, sub_region_1, iso_3166_2_code,...
## dbl (6): retail_and_recreation_percent_change_from_baseline, grocery_and_pha...
## lgl (3): sub_region_2, metro_area, census_fips_code##
## 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.vec1 <- as.vector(movilidadMX$residential_percent_change_from_baseline)
vec2 <- vec1[1:321]
num1 <- as.numeric(vec2)
Movilidad <- as.vector(num1)
datosdemovilidad <- data.frame(Fecha, Movilidad)
datatable(datosdemovilidad)Datos de movilidad en México en 2020
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)
dec_mex <- t(datos_decesos[datos_decesos$Country.Region=="Mexico" ,])
mov_mex <- movilidadMX
twit_mex <- animoMX
Fecha <- seq(from = as.Date("2020-02-15"), to = as.Date("2020-12-31"), by = "day")
vec1 <- as.vector(twit_mex$tuits_negativos)
vec2 <- vec1[1505:1825]
num1 <- as.numeric(vec2)
Twitts <- as.vector(num1)
vec1 <- as.vector(dec_mex)
vec2 <- vec1[29:349]
num1 <- as.numeric(vec2)
Decesos <- as.vector(num1)
vec1 <- as.vector(mov_mex$residential_percent_change_from_baseline)
vec2 <- vec1[1:321]
num1 <- as.numeric(vec2)
Movilidad <- as.vector(num1)
vec1 <- as.vector(twit_mex$indice)
vec2 <- vec1[1505:1825]
num1 <- as.numeric(vec2)
Indice <- as.vector(num1)
datos1 <- data.frame(Fecha, Twitts, Decesos, Movilidad, Indice)Filtrado de datos (eliminar campos no utilizados, formatear los rangos de fechas y crear un marco de datos)
gcov <- ggplot(data = datos1) +
geom_line(aes(Fecha, Twitts/1000, colour="Tweets")) +
geom_line(aes(Fecha, Decesos/1000, colour="Decesos")) +
geom_line(aes(Fecha, Movilidad, colour="Movilidad")) +
geom_line(aes(Fecha, Indice, colour="Índice de Estado de Animo")) +
xlab("Fecha") +
ylab("Cantidad") +
labs(colour="casos")+
ggtitle("Tweets Positivos - Decesos - Movilidad - Índice de Estado de Animo") +
scale_y_continuous(labels = comma)
ggplotly(gcov)Grafica interactiva de la relacion entre las variables de tweets positivos, decesos por covid, movilidad e indice de positividad.
Correlación
datos2 <- data.frame(Twitts, Decesos, Movilidad, Indice)
round(cor(x = datos2, method="pearson"), 3)## Twitts Decesos Movilidad Indice
## Twitts 1.000 -0.805 0.134 -0.823
## Decesos -0.805 1.000 -0.160 0.774
## Movilidad 0.134 -0.160 1.000 -0.186
## Indice -0.823 0.774 -0.186 1.000datos_rel <- data.frame(Decesos, Movilidad, Twitts, Indice)
round(cor(x = datos_rel, method = "pearson"), 3)## Decesos Movilidad Twitts Indice
## Decesos 1.000 -0.160 -0.805 0.774
## Movilidad -0.160 1.000 0.134 -0.186
## Twitts -0.805 0.134 1.000 -0.823
## Indice 0.774 -0.186 -0.823 1.000ggpairs(datos_rel, lower = list(continuous ="smooth"),
diag = list (continuos = "barDiag"), axisLabels = "none")
Análisis de correlación entre los 4 aspectos
corrplot(cor(dplyr::select(datos_rel, Decesos, Movilidad, Twitts, Indice)),
method = "number", tl.col = "black")
Matriz de correlación
Conclusion
De primera mano no fue posible poder llegar a concretar una hipótesis de relación muy clara, esto debido a lo que las gráficas anteriores muestran. Al analizar la correlación nos percatamos que a medida que los tweets negativos crecen los decesos bajan, y mientras se registra menos movilidad no se alcanza a notar un aumento significativo de los tweets negativos. Por lo tanto, con esto podemos inferir que no se cumple la hipótesis que sostenía que mientras más muertes, más tweets negativos circula en Twitter, sin embargo, a pesar de que el índice de estado de ánimo no varía demasiado a lo largo de la serie de tiempo, si existe una correlacion importante entre el indice y los decesos.
Descargar código
- Código de este archivo.
xfun::embed_file("CE4.Rmd")- Datos usados en este caso de estudio.
xfun::embed_file("data.csv")xfun::embed_file("2020_MX_Region_Mobility_Report.csv")Download 2020_MX_Region_Mobility_Report.csv
xfun::embed_file("time_series_covid19_deaths_global.csv")