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