AE4UC1_12

Equipo 5: Santana, Cazarez, Osuna, Urias

23/10/2021

Analisis de datos abiertos de COVID-19 en México

Importar

Descargar datos

xfun::embed_file("Casos_Diarios_Estado_Nacional_Confirmados_20211022.csv")

Download Casos_Diarios_Estado_Nacional_Confirmados_20211022.csv

#xfun::embed_file("AE4UC1_12.Rmd")

Importar datos

#Establecemos una variable para acceder a los datos
datos <- read_csv("Casos_Diarios_Estado_Nacional_Confirmados_20211022.csv")
## 
## -- Column specification --------------------------------------------------------
## cols(
##   .default = col_double(),
##   nombre = col_character()
## )
## i Use `spec()` for the full column specifications.

Transformar y filtrar

#Filtramos el estado del que queremos tomar la informacion

#Extraemos los datos a nivel nacional y los transformamos a un vector
Nacional <- t(datos[datos$nombre == "Nacional" ,])# t = transpuesta
Nacional <- as.vector(Nacional)
Nacional <- Nacional
Nacional <- Nacional[4:613]
Nacional <- as.numeric(Nacional)
Nacional<- as.vector(Nacional)

# Estructuración de los datos en un marco de datos ( Data frame)

Fecha <- seq(from= as.Date("2020-02-18"), to = as.Date("2021-10-19"), by = "day" ) #Vector de fechas desde el 2 de febrero del 2020 al 22 de Octubre del 2021

#Data frame de datos absolutos
abNacional <- data.frame(Fecha, Nacional)

Introducción

El COVID-19 ha afectado a todo el mundo con millones de casos confirmados, lo que ha provocado un aumento de las muertes. México se encuentra entre los países afectados a nivel mundial, presentando un número variable de casos diarios, los cuales serán analizados en nuestro estudio aquí.

Aquí describiremos la actividad de la propagación de COVID-19 en el país de México. Debido a la amplia capacidad de detección de casos y pruebas en México y la región especialmente, nuestro estudio representa una cohorte de población casi completa que refleja el amplio número variable de casos de COVID-19 por día.

Leemos los datos y los importamos

MXRegionMobility <- read_csv("2021_MX_Region_Mobility_Report.csv")
## 
## -- Column specification --------------------------------------------------------
## cols(
##   country_region = col_character(),
##   sub_region_1 = col_character(),
##   place_id = col_character(),
##   date = col_character(),
##   Reactivacion_Comercial = col_double(),
##   Supermercado_Farmacia = col_double(),
##   Parques_Centros = col_double(),
##   Estaciones_Transito = col_double(),
##   Lugares_Trabajo = col_double(),
##   Residencia = col_double(),
##   ContagiosCOVID = col_double()
## )

Tabla interactiva de los datos

datatable(MXRegionMobility)

Filtramos

regresionMexNacional <- (MXRegionMobility[MXRegionMobility$sub_region_1 == "Nacional" ,])# t = transpuesta
regresionMexNacional<- as.vector(regresionMexNacional)
regresionMexNacional <- regresionMexNacional
regresionMexNacional <- regresionMexNacional[,5:11]
regresionMexNacional<- as.vector(regresionMexNacional)

Tabla interactiva de los datos filtrados a nivel nacional

tablaNacional <- (MXRegionMobility[MXRegionMobility$sub_region_1 == "Nacional" ,])# t = transpuesta
tablaNacional<- as.vector(tablaNacional)
datatable(tablaNacional)

series de tiempo

pairs(regresionMexNacional)

Para entender como serie de tiempo la movilidad de google vs los contaminantes de la estación ERNO, haremos un gráfico interactivo con GGPLOT2

Fecha <- seq(from= as.Date("2021-01-1"), to = as.Date("2021-10-19"), by = "day" )

movilidad <- ggplot(regresionMexNacional) +
   geom_line(aes(x= Fecha, y= Reactivacion_Comercial,colour= "Recreación y comercio")) +
   geom_line(aes(x= Fecha, y= Supermercado_Farmacia,colour= "Supermercados y farmacias")) +
   geom_line(aes(x= Fecha, y= Parques_Centros, colour= "Parques")) +
   geom_line(aes(x= Fecha, y= Estaciones_Transito, colour= "Estaciones de tránsito")) +
   geom_line(aes(x= Fecha, y= Lugares_Trabajo,colour= "Lugares de trabajo")) +
   geom_line(aes(x= Fecha, y= Residencia,colour= "Lugares residenciales")) +
   labs(title= "Reporte de movilidad",x= "Fecha",y= "Procentaje de cambio de movilidad")

ggplotly(movilidad)
#Si sube transito O3 sube, si sube la gente en su casa O3 baja

Tomando en cuenta que los datos empiezan el primero de Enero del 2021, vemos como la gente ya estaba saliendo mas lo que se ve en los distintos picos que tienen los lugares residenciales, lugares de trabajo, en las estaciones, y obviamente con la vacuna y las nomras de sanidad los supermercados y farmacias abrieron mas o menos con la misma tranquilidad que lo hacían antes, lo que por obvias razones ya sea por el mandado de la canasta básica o por medicinas obtienen una cantidad de personas mayor a los factores como serian los parques.

Por otro lado lado los lugares de trabajo se mantienen igual de irregulares ya que aunque haya pandemía se tiene que ganar la moneda diaria para poder comer.

Día de la Candelaria es 02 de Febrero en este caso donde se ve obviamente un pico ademas de ver que el primer Lunes se celebra la constitución.

El 15 de Marzo que fue el día de Benito Juarez, hubo un puente para los estudiantes y trabajadores lo que los llevo a o quedarse en casa a descansar o ir a algun lugar para buscar entretenimiento.

El 2 de Abril que fue la toma de Puebla también se tiene como día festivo.

Y los picos mas obvios son los días entre 15 - 22 de Septiembre hay varios festejos Mexicanos lo que le da un pico enorme tanto positiva como negativamente ya que la gente empieza a salir y celebra las fiestas patrias.

Falta por tener clase:

Regresión Lineal Multiple

Análisis de relación entre variables

datos <- as.data.frame(regresionMexNacional)
round(cor(x = datos, method = "pearson"), 3) #3 son la cantidad numeros decimales que mostrara
##                        Reactivacion_Comercial Supermercado_Farmacia
## Reactivacion_Comercial                  1.000                 0.981
## Supermercado_Farmacia                   0.981                 1.000
## Parques_Centros                         0.938                 0.926
## Estaciones_Transito                     0.898                 0.880
## Lugares_Trabajo                         0.491                 0.469
## Residencia                             -0.578                -0.548
## ContagiosCOVID                         -0.009                 0.013
##                        Parques_Centros Estaciones_Transito Lugares_Trabajo
## Reactivacion_Comercial           0.938               0.898           0.491
## Supermercado_Farmacia            0.926               0.880           0.469
## Parques_Centros                  1.000               0.896           0.528
## Estaciones_Transito              0.896               1.000           0.800
## Lugares_Trabajo                  0.528               0.800           1.000
## Residencia                      -0.624              -0.820          -0.917
## ContagiosCOVID                  -0.079              -0.164          -0.337
##                        Residencia ContagiosCOVID
## Reactivacion_Comercial     -0.578         -0.009
## Supermercado_Farmacia      -0.548          0.013
## Parques_Centros            -0.624         -0.079
## Estaciones_Transito        -0.820         -0.164
## Lugares_Trabajo            -0.917         -0.337
## Residencia                  1.000          0.432
## ContagiosCOVID              0.432          1.000

Histogramas de variables

multi.hist(x = regresionMexNacional[,1:6], dcol = c("blue", "red"), dlty = c("dotted", "solid"),
           main = "")

#Ignoramos la columa de contagiados para poder visualizar los daots

Gráfico 6: Tablas de histogramas de los datos

Explicacion

Gráfica de dispersión de variables

ggpairs(regresionMexNacional, lower = list(continuous = "smooth"), diag = list(continuous = "barDiag"), axisLabels = "none")
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.
## `stat_bin()` using `bins = 30`. Pick better value with `binwidth`.

Gráfico 7: Matriz de graficas de dispersión de las variables

Explicación

Creación del modelo

modelo <- lm(ContagiosCOVID ~ Reactivacion_Comercial + Supermercado_Farmacia + Parques_Centros + Estaciones_Transito + Lugares_Trabajo + Residencia, data = datos)

summary(modelo)
## 
## Call:
## lm(formula = ContagiosCOVID ~ Reactivacion_Comercial + Supermercado_Farmacia + 
##     Parques_Centros + Estaciones_Transito + Lugares_Trabajo + 
##     Residencia, data = datos)
## 
## Residuals:
##      Min       1Q   Median       3Q      Max 
## -11768.1  -3939.4   -881.5   2875.4  15328.7 
## 
## Coefficients:
##                        Estimate Std. Error t value Pr(>|t|)    
## (Intercept)            -5423.26    4082.46  -1.328    0.185    
## Reactivacion_Comercial    87.29     162.40   0.538    0.591    
## Supermercado_Farmacia    102.96     123.49   0.834    0.405    
## Parques_Centros         -118.91     107.35  -1.108    0.269    
## Estaciones_Transito      110.28     164.47   0.670    0.503    
## Lugares_Trabajo          129.35      81.45   1.588    0.113    
## Residencia              1832.77     240.56   7.619 3.81e-13 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 5234 on 285 degrees of freedom
## Multiple R-squared:  0.3123, Adjusted R-squared:  0.2978 
## F-statistic: 21.57 on 6 and 285 DF,  p-value: < 2.2e-16

Explicacion

Selección de los mejores predictores

En este caso se van a emplear la estrategia de stepwise mixto. El valor matemático empleado para determinar la calidad del modelo va a ser Akaike(AIC).

step(object = modelo, direction = "both", trace = 1)
## Start:  AIC=5007.67
## ContagiosCOVID ~ Reactivacion_Comercial + Supermercado_Farmacia + 
##     Parques_Centros + Estaciones_Transito + Lugares_Trabajo + 
##     Residencia
## 
##                          Df  Sum of Sq        RSS    AIC
## - Reactivacion_Comercial  1    7914721 7815591053 5006.0
## - Estaciones_Transito     1   12315343 7819991675 5006.1
## - Supermercado_Farmacia   1   19043571 7826719903 5006.4
## - Parques_Centros         1   33611607 7841287939 5006.9
## <none>                                 7807676332 5007.7
## - Lugares_Trabajo         1   69089572 7876765903 5008.2
## - Residencia              1 1590150599 9397826931 5059.8
## 
## Step:  AIC=5005.97
## ContagiosCOVID ~ Supermercado_Farmacia + Parques_Centros + Estaciones_Transito + 
##     Lugares_Trabajo + Residencia
## 
##                          Df  Sum of Sq        RSS    AIC
## - Estaciones_Transito     1   29542551 7845133604 5005.1
## - Parques_Centros         1   31210406 7846801459 5005.1
## <none>                                 7815591053 5006.0
## - Lugares_Trabajo         1   61477285 7877068338 5006.3
## - Supermercado_Farmacia   1   78805862 7894396915 5006.9
## + Reactivacion_Comercial  1    7914721 7807676332 5007.7
## - Residencia              1 1584522532 9400113585 5057.9
## 
## Step:  AIC=5005.07
## ContagiosCOVID ~ Supermercado_Farmacia + Parques_Centros + Lugares_Trabajo + 
##     Residencia
## 
##                          Df  Sum of Sq        RSS    AIC
## - Parques_Centros         1   10456387 7855589991 5003.5
## <none>                                 7845133604 5005.1
## + Estaciones_Transito     1   29542551 7815591053 5006.0
## + Reactivacion_Comercial  1   25141929 7819991675 5006.1
## - Supermercado_Farmacia   1  326333058 8171466662 5015.0
## - Lugares_Trabajo         1  348633975 8193767579 5015.8
## - Residencia              1 1585805583 9430939187 5056.8
## 
## Step:  AIC=5003.46
## ContagiosCOVID ~ Supermercado_Farmacia + Lugares_Trabajo + Residencia
## 
##                          Df  Sum of Sq        RSS    AIC
## <none>                                 7855589991 5003.5
## + Reactivacion_Comercial  1   12911225 7842678766 5005.0
## + Parques_Centros         1   10456387 7845133604 5005.1
## + Estaciones_Transito     1    8788532 7846801459 5005.1
## - Lugares_Trabajo         1  367280964 8222870955 5014.8
## - Supermercado_Farmacia   1 1127796932 8983386922 5040.6
## - Residencia              1 1787980010 9643570001 5061.3
## 
## Call:
## lm(formula = ContagiosCOVID ~ Supermercado_Farmacia + Lugares_Trabajo + 
##     Residencia, data = datos)
## 
## Coefficients:
##           (Intercept)  Supermercado_Farmacia        Lugares_Trabajo  
##               -6383.0                  180.1                  174.7  
##            Residencia  
##                1859.6

Explicacion

Confint

confint(lm(formula = ContagiosCOVID ~ Reactivacion_Comercial + Supermercado_Farmacia + Parques_Centros + Estaciones_Transito + Lugares_Trabajo + Residencia, data = datos))
##                               2.5 %     97.5 %
## (Intercept)            -13458.86778 2612.33993
## Reactivacion_Comercial   -232.36604  406.94685
## Supermercado_Farmacia    -140.11054  346.03321
## Parques_Centros          -330.21493   92.39453
## Estaciones_Transito      -213.46173  434.01437
## Lugares_Trabajo           -30.97202  289.66660
## Residencia               1359.26615 2306.27406

Explicacion

plot1 <- ggplot(data = datos, aes(ContagiosCOVID, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot2 <- ggplot(data = datos, aes(Reactivacion_Comercial, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot3 <- ggplot(data = datos, aes(Supermercado_Farmacia, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot4 <- ggplot(data = datos, aes(Parques_Centros, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot5 <- ggplot(data = datos, aes(Estaciones_Transito, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot6 <- ggplot(data = datos, aes(Lugares_Trabajo, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
plot7 <- ggplot(data = datos, aes(Residencia, modelo$residuals)) +
    geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
    theme_bw()
grid.arrange(plot1, plot2, plot3, plot4, plot5, plot6, plot7)
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'
## `geom_smooth()` using method = 'loess' and formula 'y ~ x'

Gráfico 8: Graficos de plot organizados de los casos confirmados de COVID en zonas

Distribución Normal de los residuos

qqnorm(modelo$residuals)
qqline(modelo$residuals)

Gráfico 9: Grafico de plot de los cuantiles de los residuales

Explicacion

shapiro.test(modelo$residuals)
## 
##  Shapiro-Wilk normality test
## 
## data:  modelo$residuals
## W = 0.96043, p-value = 3.875e-07