Estado de Ánimo de los tuiteros en México.

Es bien sabido que la pandemia nos pegó a todos de forma significativa, ya sea para bien o para mal. Ahora con los avances tecnologicos que hay, es relativamente más fácil percibir los cambios por los que pasa la sociedad, puesto que en redes sociales se puede llegar a observar la conformidad o inconformidad de ciertas situaciones. Gracias a las publicaciones que realizan los usuarios se puede recopilar esos datos y conocer el estado de animo del individuo que realizó dicha publicación.

Por estado de animo nos referimos a la actitud o disposición emocional que poseemos. A diferencia de los sentimientos y las emociones, los cuales pueden ser muy cambiantes, el estado de ánimo tiene una duración prolongada, con procesos de cambio menos frecuente.

En este documento se estará realizando un analisis del cambio en el estado de animo especificamente de los tuiteros en México a lo largo de la pandemia.

Paquetes

library(pacman)
p_load("DT","xfun","ggplot2", "readr","tseries","ggfortify","tidyr", "dplyr","prettydoc",  "psych", "GGally", "stringr","vembedr","gridExtra","corrplot", "plotly","base64enc", "htmltools", "mime",  "knitr", "gganimate","gifski","scales")

Datos

Los datos que se estarán utilizando son sacados de la pagina del INEGI, se puede acceder a ellos con el siguiente enlace https://www.inegi.org.mx/app/animotuitero/#/app/multiline

Se importan los datos desde el .csv y es presentado mediante una tabla

animo <- read_csv("data (1).csv")

## Rows: 325 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.

animo2 <- data.frame(animo)
datatable(animo)

Gráfica de los datos

plot_ly(data = animo, x = animo$fecha , y = animo$indice, type = 'scatter' , mode = 'lines')%>% layout(title = 'Estado de ánimo de \ntwitteros en México',
         yaxis = list(zeroline = FALSE, title = 'Indice'),
         xaxis = list(zeroline = FALSE), title = 'Fecha')

En la gráfica podemos observar que el estado de animo se mantenia un indice medianamente estable en el 2016, pero en septiembre de 2017 bajó, esto se puede deber a que en ese mes sucedieron dos terremotos, el primero fue de 7.1 en la escala Richter y el segundo fue de 6.4, esto pudo haber afectado al estado de animo de los tuiteros, pero posteriormente subió.

Podemos ver que el pico más bajo ocurrió en marzo de 2020, en el mes en el que inició la pandemia y se decidió realizar cuarentena, para prevenir riesgos. Posterior a esta fecha se puede ver quue el estado de animo subió, pero volvió a caer en Junio del mismo año, esto se puede deber a que iban a ser vacacines y seguia la pandemia o porque los casos solo iban en aumento.

También se puede observar que durante el tiempo de pandemia los picos más altos se dieron durante diciembre.

Se dividen los datos por año

animo2022 <- animo%>% 
  filter(between(fecha, as.Date("2022-01-01"), as.Date("2022-12-31")))

animo2022 <- cbind(animo2022, anio=2022)

animo2021 <- animo%>% 
  filter(between(fecha, as.Date("2021-01-01"), as.Date("2021-12-31")))

animo2021 <- cbind(animo2021, anio=2021)

animo2020 <- animo%>% 
  filter(between(fecha, as.Date("2020-01-01"), as.Date("2020-12-31")))

animo2020 <- cbind(animo2020, anio=2020)

animo2019 <- animo%>% 
  filter(between(fecha, as.Date("2019-01-01"), as.Date("2019-12-31")))

animo2019 <- cbind(animo2019, anio=2019)

animo2018 <- animo%>% 
  filter(between(fecha, as.Date("2018-01-01"), as.Date("2018-12-31")))

animo2018 <- cbind(animo2018, anio=2018)

animo2017 <- animo%>% 
  filter(between(fecha, as.Date("2017-01-01"), as.Date("2017-12-31")))

animo2017 <- cbind(animo2017, anio=2017)

animo2016 <- animo%>% 
  filter(between(fecha, as.Date("2016-01-01"), as.Date("2016-12-31")))

animo2016 <- cbind(animo2016, anio=2016)


newAnimo = rbind(animo2016 , animo2017 , animo2018 , animo2019 , animo2020 , animo2021 , animo2022)

Grafica de caja y bigote

boxplot(newAnimo$indice~newAnimo$anio ,col = "#8968CD", xlab="Año", ylab="Indice", main="Estado de Ánimo de twitteros")

abline(h = mean(animo2016$indice), col = "#009ACD")
abline(h = mean(newAnimo$indice) , col = "deeppink3")
abline(h = mean(animo2020$indice), col = "firebrick4")

Como pudimos apreciar en la gráfica anterior, el estado de animo empezó a bajar después del 2016, siendo el 2020 el punto más bajo y posterior a edicho año, el estado de animo sube.

Gráfica comparativa interactiva

p <- plot_ly(x=newAnimo, y=animo2016$indice, mode = 'lines', type="scatter", name="2016") %>%
  layout(title = 'Estado de ánimo de \ntwitteros en México' ,
         yaxis = list(zeroline = FALSE, title = 'Indice'),
         xaxis = list(zeroline = FALSE, title = 'Día del Año'), legend = list(font = list(size = 15)))
p <- add_trace(p,y=animo2017$indice, name="2017")
p <- add_trace(p,y=animo2018$indice, name="2018")
p <- add_trace(p,y=animo2019$indice, name="2019")
p <- add_trace(p,y=animo2020$indice, name="2020")
p <- add_trace(p,y=animo2021$indice, name="2021")
p <- add_trace(p,y=animo2022$indice, name="2022")
p

En la gráfica se puede comparar el indice de estado de animo entre los diferentes años, de esta forma se puede notar más la diferencia

Conclusión Personal

Con estos datos nos damos cuenta que la pandemia fue una variable que tuvo mucho que ver con los estados de animo, por todas las cuestiones dificiles que las personas pudieron haber pasado durante los años de la pandemia.

xfun::embed_file("A7U1-Equipo5.Rmd")

Download A7U1-Equipo5.Rmd

#se realiza la declaración de las variables que contendrán las url en donde se encuentran los datos crudos de confirmados, decesos, recuperados


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"
dato_twitter <- "data (1).csv"
dato_movilidad <- "2020_MX.csv"


#Leer los archivos .csv de las url 

datos_decesos <- read.csv(url_decesos)
datos_twitter <- read.csv(dato_twitter)
datos_movilidad <- read.csv(dato_movilidad)

#definir variables
twit_mexico <- datos_twitter
deceso_mexico  <- t(datos_decesos[datos_decesos$Country.Region=="Mexico" ,])
movilidad_mexico  <- datos_movilidad

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

#casos twits 
vec1 <- as.vector(twit_mexico$tuits_positivos)
vec2 <- vec1[29:349]
num1 <- as.numeric(vec2)
Twitts <- as.vector(num1)

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

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

#generación de un marco de datos (data frame)

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

Gráfica estática

gcov <- ggplot(data = datos1) +
  geom_line(aes(Fecha, Twitts, colour="Twits")) +
  geom_line(aes(Fecha, Decesos, colour="Decesos")) +
  geom_line(aes(Fecha, Movilidad, colour="Residencia")) +
  xlab("Fecha") +
  ylab("COVID-19 en México") +
  labs(colour="casos")+
  ggtitle("Casos de COVID-19 en México (Fuente: JHU CSSE") +
  scale_y_continuous(labels = comma)
gcov

## Warning: Removed 24 row(s) containing missing values (geom_path).

# Gráfica interactiva

ggplotly(gcov)

ggplot(data = datos1) +
  geom_line(aes(Fecha, Twitts, colour="Twits")) +
  geom_line(aes(Fecha, Decesos, colour="Decesos")) +
  geom_line(aes(Fecha, Movilidad, colour="Residencia")) +
  xlab("Fecha") +
  ylab("COVID-19 en México") +
  labs(colour="casos")+
  ggtitle("Casos de COVID-19 en México (Fuente: JHU CSSE") +
  scale_y_continuous(labels = comma) +
  transition_reveal(Fecha)

## Warning: Removed 3 row(s) containing missing values (geom_path).

## Warning: Removed 7 row(s) containing missing values (geom_path).

## Warning: Removed 10 row(s) containing missing values (geom_path).

## Warning: Removed 13 row(s) containing missing values (geom_path).

## Warning: Removed 16 row(s) containing missing values (geom_path).

## Warning: Removed 20 row(s) containing missing values (geom_path).

## Warning: Removed 23 row(s) containing missing values (geom_path).

## Warning: Removed 24 row(s) containing missing values (geom_path).