Datos y Paquetes

library(pacman)
p_load("DT","xfun","ggplot2", "readr","tseries","ggfortify","tidyr", "dplyr","prettydoc",  "psych", "GGally", "stringr","vembedr", "xfun","gridExtra","corrplot", "plotly")

Datos

Los datos que se utilizaran son sacados de la pagina del INEGI, el cual lo pueden ver aqui: https://www.inegi.org.mx/app/animotuitero/#/app/multiline

Se importan los datos desde el .csv

twits <- read_csv("twits.csv")

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

twits

## # A tibble: 75 x 7
##    fecha      tuits_negativos indice recoleccion_promedio tipo_usuario lugar
##    <date>               <dbl>  <dbl>                <dbl> <chr>        <chr>
##  1 2016-01-01         1269505   2.36              136739. todos        NAC  
##  2 2016-02-01         1098442   2.48              131794. todos        NAC  
##  3 2016-03-01         1296862   2.41              142092. todos        NAC  
##  4 2016-04-01         1360176   2.27              147715. todos        NAC  
##  5 2016-05-01         1471456   2.26              154664. todos        NAC  
##  6 2016-06-01         1447713   2.27              157116. todos        NAC  
##  7 2016-07-01         1400805   2.30              148718. todos        NAC  
##  8 2016-08-01         1409549   2.21              145745. todos        NAC  
##  9 2016-09-01         1249556   2.15              130977. todos        NAC  
## 10 2016-10-01         1158539   2.26              121517. todos        NAC  
## # ... with 65 more rows, and 1 more variable: tuits_positivos <dbl>

datatable(twits)

Gráfica de los datos interactiva

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

Como se puede observar en la grafica, el estado de animo de los twitteros era todo relativamente normal hasta que en marzo del 2020 hasta la actualidadlos twits se volvieron negativos por el inicio y por lo sucedido en la pandemia, tomando en cuenta que entre mas arriba la linea mas positivos los twitteros y entre mas abajo la linea mas negativos los twits

También podemos observar que los picos más altos se dan en días festivos cómo lo son:

• Año nuevo
• Navidad
• Día del Niño
• Entre otros

Dividiendo los datos por año

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

twits2022 <- cbind(twits2022, anio=2022)

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

twits2021 <- cbind(twits2021, anio=2021)

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

twits2020 <- cbind(twits2020, anio=2020)

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

twits2019 <- cbind(twits2019, anio=2019)

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

twits2018 <- cbind(twits2018, anio=2018)

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

twits2017 <- cbind(twits2017, anio=2017)

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

twits2016 <- cbind(twits2016, anio=2016)


newTwits = rbind(twits2016 , twits2017 , twits2018 , twits2019 , twits2020 , twits2021 , twits2022)

Grafica de caja y bigote sobre el estado de ánimo

Para comparar como se ha desarrollado el estado de ánimo de los Twitteros a traves de los años se utilizara una grafica de caja y bigotes.

boxplot(newTwits$indice~newTwits$anio ,col = "green", xlab="Año", ylab="Indice", main="Estado de Ánimo de twitteros")

abline(h = mean(twits2016$indice) , col = "blue")
abline(h = mean(newTwits$indice) , col = "yellow")
abline(h = mean(twits2020$indice) , col = "red")

La línea azul representa la media de estado de ánimo más alta. La línea amarilla representa la media de estado de ánimo en general. La línea roja representa media de estado de ánimo mínima.

Como se puede ver en la grafica que apartir del año 2016 empezó a bajar el estado de animo drasticamente y esto se debe a varios factores, pero despues del año 2020 este empezó a subir.

Gráfica comparativa interactiva

En la siguiente gráfica se puede comparar el indice de los estados de ánimo entre diferentes años.

p <- plot_ly(x=newTwits, y=twits2016$indice, mode = 'lines', type="scatter", name="2016") %>%
  layout(title = 'Estado de ánimo de twitteros 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=twits2017$indice, name="2017")
p <- add_trace(p,y=twits2018$indice, name="2018")
p <- add_trace(p,y=twits2019$indice, name="2019")
p <- add_trace(p,y=twits2020$indice, name="2020")
p <- add_trace(p,y=twits2021$indice, name="2021")
p <- add_trace(p,y=twits2022$indice, name="2022")
p

Datos de JHU CSSE

Importaremos los datos crudos de la Johns Hopkins Academy CSSE globales, de esta forma definiremos las variables utilizando unicamente la región de México.

arch_twitter <- "twits_dia.csv"

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"

arch_movilidad <-"2020_MX_Region_Mobility_Report.csv"

#Leer los archivos
datos_twitter <- read.csv(arch_twitter)
datos_decesos <- read.csv(url_decesos)
datos_movilidad <- read.csv(arch_movilidad)

#definir variables 
twit_mex <- datos_twitter 
dec_mex  <- t(datos_decesos[datos_decesos$Country.Region=="Mexico" ,])
mov_mex  <- datos_movilidad

Formatear datos

Se crea un vector de fecha del 22 de enero a 2020 hasta el 31 de diciembre de 2021, dia por dia. Este será nuestro rango de fecha para visualizar los datos, además se crean los vectores para los twits, decesos y la movilidad abarcando todas las columnas para asignarlos a las fechas y finalmente el data frame con todos estos vectores.

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

#twits
vec1 <- as.vector(twit_mex$tuits_negativos)
vec2 <- vec1[1505:1825]
num1 <- as.numeric(vec2)
Twits <- as.vector(num1)

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

#movilidad
vec1 <- as.vector(mov_mex$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, Twits, Decesos, Movilidad)

Gráfica estática

gcov <- ggplot(data = datos1) +
  geom_line(aes(Fecha, Twits, colour="Twits negativos")) +
  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

Gráfica interactiva

ggplotly(gcov)

Gráfica interactiva para que el usuario pueda acercar y descargar la imagen de la gráfica.

Gráfica animada

ggplot(data = datos1) +
  geom_line(aes(Fecha, Twits, colour="Twits negativos")) +
  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)

Gráfica animada para ver el crecimiento gradual de las tres variables.