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")## Rows: 33 Columns: 616## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (2): cve_ent, nombre
## dbl (614): poblacion, 18-02-2020, 19-02-2020, 20-02-2020, 21-02-2020, 22-02-...##
## 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.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)
aNacional <- cumsum(Nacional) #aALGO significa acumulado de algo
# 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.
Visualiza
Tabla
Tabla interactiva de datos diarios absolutos a nivel nacional
#Tabla interactiva de datos diarios absolutos de abNacional
datatable(abNacional)Análisis de series de tiempo (TSA)
Para este ejercicio usaremos datos de los casos confirmados de covid-19 en México a nivel nacional desde el 18 de Febrero del 2020 hasta hasta el 15 de Octubre del 2021
Grafiquemos los datos
Ahora transformaremos este vector numerico a un objeto de serie de tiempo
revolucion.ts <- ts(data=Nacional,start = c(2020,2), frequency = 365)Ahora grafiquemos con respecto al tiempo
plot(revolucion.ts)
Gráfico 1: Analisis de serie de tiempo de cosos confirmados de COVID
Aqui podemos observar claramente las 3 olas de contagios que provoco el COVID-19
Decomposición de series de tiempo
Analizamos una serie de tiempo desde sus componentes estructurales
En este modelo, la serie observada es el resultado de sumar una tendencia que representa el comportamiento a largo plazo de la serie, un efecto estacional que describe sus fluctuaciones periódicas y un componente residual que describe las variaciones a corto plazo, normalmente impredecibles.
Con R es muy sencillo obtener una descomposición estructural de este tipo. Se usa el comando decompose:
\[ serie observada = Tendencia + efecto estacional + residuos \]
Esta descomposición se basa en métodos elementales:
la tendencia se calcula con una media móvil,
el efecto estacional se calcula promediando los valores de cada unidad de tiempo para todos los periodos (por ejemplo, todos los meses de enero si la serie es mensual) y luego centrando el resultado. Finalmente,
los residuos se obtienen restando a la serie observada las dos componentes anteriores.
La descomposicion solo es totalmente adecuada si se dispone de un número completo de periodos (por ejemplo, un múltiplo de 12 si la serie es mensual).
Transformaciones básicas de una serie
En el gráfico de dMuertos.ts se observa que la serie no es estacionaria. La serie presenta una tendencia aparentemente lineal en decenso y una estacionalidad muy marcada (las busquedas aumentan por Octubre a pesar de no ser el día que se busca). Además, la amplitud de las fluctuaciones decae con el tiempo por lo que la variabilidad tampoco es constante. Sin embargo, muchos modelos importantes de series temporales corresponden a series estacionarias (es decir, sin tendencia ni estacionalidad y con variabilidad constante). Antes de ajustar un modelo estacionario tenemos que transformar la serie original.
Estabilización de la varianza: Para estabilizar la variabilidad se suelen tomar logaritmos. Esta transformación funcionará bien cuando la variabilidad sea aproximadamente proporcional al nivel de la serie. Representamos la serie transformada mediante
plot(log((revolucion.ts)))
Gráfico 6.4: Graficos de dispersión de las variables
Eliminacion de la tendencia: Una forma sencilla de eliminar una tendencia aproximadamente lineal es diferenciar la serie, es decir, considerar la serie de diferencias entre una observación y la anterior en lugar de la serie original. Si xt es una serie contenida en x, para calcular:
\[ \nabla x_t = x_t -x_{t-1} \]
x <- log(revolucion.ts)
dif1.x <- diff(x)
plot(dif1.x)
Gráfico 6.4: Graficos de dispersión de las variables
Eliminación de estacionalidad: Para eliminar la estacionalidad de una serie mensual se pueden tomar diferencias estacionales de orden 12. Si xt es la serie que queremos desestacionalizar, se trata de calcular:
\[ \nabla_{12} x_t = x_t - x_{t-12} \]
dif12.dif1.x <- diff(dif1.x, lag = 12)
plot(dif12.dif1.x)
Gráfico 6.4: Graficos de dispersión de las variables
Ahora con las gráficas descompuestas:
Los datos aumentan con el tiempo, ¿pero es el tiempo la causa que aumenten los casos?
Si aumentan con el tiempo, pero la causa del aumento de casos no es por el tiempo, si no por aglomeración de personas en un solo lugar por festividades nacionales donde las personas se reúnen y no llevan a cabo las reglas de uso correcto del cubrebocas y la distancia de 1.5m de cada persona.
¿Qué es lo que hace que los contagios suban y bajen? la movilidad
Regresión Lineal Multiple
Leemos los datos y los importamos
MXRegionMobility <- read_csv("2021_MX_Region_Mobility_Report.csv")## Rows: 9636 Columns: 11## -- Column specification --------------------------------------------------------
## Delimiter: ","
## chr (4): country_region, sub_region_1, place_id, date
## dbl (7): Recreacion_y_comercio, Supermercados_y_farmacias, Parques, Estacion...##
## 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.Tabla interactiva de los datos
datatable(MXRegionMobility)Filtrado de los datos
Aqui los filtramos a nivel nacional
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)Reporte de Movilidad
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= regresionMexNacional$Recreacion_y_comercio, colour= "Recreación y comercio"))+
geom_line(aes(x= Fecha,y= regresionMexNacional$Supermercados_y_farmacias, colour= "Supermercados y farmacias"))+
geom_line(aes(x= Fecha,y= regresionMexNacional$Parques, colour= "Parques"))+
geom_line(aes(x= Fecha,y= regresionMexNacional$Estaciones_de_transito, colour= "Estaciones de tránsito"))+
geom_line(aes(x= Fecha,y= regresionMexNacional$Lugar_de_trabajo, colour= "Lugares de trabajo"))+
geom_line(aes(x= Fecha,y= regresionMexNacional$Zona_residencial, colour= "Zonas residenciales"))+
#geom_line(aes(x= Fecha,y= regresionMexNacional$ContagiosCOVID, colour= "Contagios confirmados por COVID"))+
labs(title= "Reporte de movilidad", x= "Fecha", y= "Procentaje de cambio de movilidad")
ggplotly(movilidad)## Warning: Use of `regresionMexNacional$Recreacion_y_comercio` is discouraged. Use
## `Recreacion_y_comercio` instead.## Warning: Use of `regresionMexNacional$Supermercados_y_farmacias` is discouraged.
## Use `Supermercados_y_farmacias` instead.## Warning: Use of `regresionMexNacional$Parques` is discouraged. Use `Parques`
## instead.## Warning: Use of `regresionMexNacional$Estaciones_de_transito` is discouraged.
## Use `Estaciones_de_transito` instead.## Warning: Use of `regresionMexNacional$Lugar_de_trabajo` is discouraged. Use
## `Lugar_de_trabajo` instead.## Warning: Use of `regresionMexNacional$Zona_residencial` is discouraged. Use
## `Zona_residencial` instead.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.
Gráfico 6: Graficos de dispersión de las variables
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## Recreacion_y_comercio Supermercados_y_farmacias
## Recreacion_y_comercio 1.000 0.981
## Supermercados_y_farmacias 0.981 1.000
## Parques 0.938 0.926
## Estaciones_de_transito 0.898 0.880
## Lugar_de_trabajo 0.491 0.469
## Zona_residencial -0.578 -0.548
## ContagiosCOVID -0.009 0.013
## Parques Estaciones_de_transito Lugar_de_trabajo
## Recreacion_y_comercio 0.938 0.898 0.491
## Supermercados_y_farmacias 0.926 0.880 0.469
## Parques 1.000 0.896 0.528
## Estaciones_de_transito 0.896 1.000 0.800
## Lugar_de_trabajo 0.528 0.800 1.000
## Zona_residencial -0.624 -0.820 -0.917
## ContagiosCOVID -0.079 -0.164 -0.337
## Zona_residencial ContagiosCOVID
## Recreacion_y_comercio -0.578 -0.009
## Supermercados_y_farmacias -0.548 0.013
## Parques -0.624 -0.079
## Estaciones_de_transito -0.820 -0.164
## Lugar_de_trabajo -0.917 -0.337
## Zona_residencial 1.000 0.432
## ContagiosCOVID 0.432 1.000Histogramas 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 daotsGrá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 5: Graficos de dispersión de las variables
Explicación
Creación del modelo
modelo <- lm(ContagiosCOVID ~ Recreacion_y_comercio + Supermercados_y_farmacias + Parques + Estaciones_de_transito + Lugar_de_trabajo + Zona_residencial, data = datos)
summary(modelo)##
## Call:
## lm(formula = ContagiosCOVID ~ Recreacion_y_comercio + Supermercados_y_farmacias +
## Parques + Estaciones_de_transito + Lugar_de_trabajo + Zona_residencial,
## 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
## Recreacion_y_comercio 87.29 162.40 0.538 0.591
## Supermercados_y_farmacias 102.96 123.49 0.834 0.405
## Parques -118.91 107.35 -1.108 0.269
## Estaciones_de_transito 110.28 164.47 0.670 0.503
## Lugar_de_trabajo 129.35 81.45 1.588 0.113
## Zona_residencial 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-16Selecció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 ~ Recreacion_y_comercio + Supermercados_y_farmacias +
## Parques + Estaciones_de_transito + Lugar_de_trabajo + Zona_residencial
##
## Df Sum of Sq RSS AIC
## - Recreacion_y_comercio 1 7914721 7815591053 5006.0
## - Estaciones_de_transito 1 12315343 7819991675 5006.1
## - Supermercados_y_farmacias 1 19043571 7826719903 5006.4
## - Parques 1 33611607 7841287939 5006.9
## <none> 7807676332 5007.7
## - Lugar_de_trabajo 1 69089572 7876765903 5008.2
## - Zona_residencial 1 1590150599 9397826931 5059.8
##
## Step: AIC=5005.97
## ContagiosCOVID ~ Supermercados_y_farmacias + Parques + Estaciones_de_transito +
## Lugar_de_trabajo + Zona_residencial
##
## Df Sum of Sq RSS AIC
## - Estaciones_de_transito 1 29542551 7845133604 5005.1
## - Parques 1 31210406 7846801459 5005.1
## <none> 7815591053 5006.0
## - Lugar_de_trabajo 1 61477285 7877068338 5006.3
## - Supermercados_y_farmacias 1 78805862 7894396915 5006.9
## + Recreacion_y_comercio 1 7914721 7807676332 5007.7
## - Zona_residencial 1 1584522532 9400113585 5057.9
##
## Step: AIC=5005.07
## ContagiosCOVID ~ Supermercados_y_farmacias + Parques + Lugar_de_trabajo +
## Zona_residencial
##
## Df Sum of Sq RSS AIC
## - Parques 1 10456387 7855589991 5003.5
## <none> 7845133604 5005.1
## + Estaciones_de_transito 1 29542551 7815591053 5006.0
## + Recreacion_y_comercio 1 25141929 7819991675 5006.1
## - Supermercados_y_farmacias 1 326333058 8171466662 5015.0
## - Lugar_de_trabajo 1 348633975 8193767579 5015.8
## - Zona_residencial 1 1585805583 9430939187 5056.8
##
## Step: AIC=5003.46
## ContagiosCOVID ~ Supermercados_y_farmacias + Lugar_de_trabajo +
## Zona_residencial
##
## Df Sum of Sq RSS AIC
## <none> 7855589991 5003.5
## + Recreacion_y_comercio 1 12911225 7842678766 5005.0
## + Parques 1 10456387 7845133604 5005.1
## + Estaciones_de_transito 1 8788532 7846801459 5005.1
## - Lugar_de_trabajo 1 367280964 8222870955 5014.8
## - Supermercados_y_farmacias 1 1127796932 8983386922 5040.6
## - Zona_residencial 1 1787980010 9643570001 5061.3##
## Call:
## lm(formula = ContagiosCOVID ~ Supermercados_y_farmacias + Lugar_de_trabajo +
## Zona_residencial, data = datos)
##
## Coefficients:
## (Intercept) Supermercados_y_farmacias
## -6383.0 180.1
## Lugar_de_trabajo Zona_residencial
## 174.7 1859.6Confint
confint(lm(formula = ContagiosCOVID ~ Recreacion_y_comercio + Supermercados_y_farmacias + Parques + Estaciones_de_transito + Lugar_de_trabajo + Zona_residencial, data = datos))## 2.5 % 97.5 %
## (Intercept) -13458.86778 2612.33993
## Recreacion_y_comercio -232.36604 406.94685
## Supermercados_y_farmacias -140.11054 346.03321
## Parques -330.21493 92.39453
## Estaciones_de_transito -213.46173 434.01437
## Lugar_de_trabajo -30.97202 289.66660
## Zona_residencial 1359.26615 2306.27406plot1 <- ggplot(data = datos, aes(ContagiosCOVID, modelo$residuals)) +
geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
theme_bw()
plot2 <- ggplot(data = datos, aes(Recreacion_y_comercio, modelo$residuals)) +
geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
theme_bw()
plot3 <- ggplot(data = datos, aes(Supermercados_y_farmacias, modelo$residuals)) +
geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
theme_bw()
plot4 <- ggplot(data = datos, aes(Parques, modelo$residuals)) +
geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
theme_bw()
plot5 <- ggplot(data = datos, aes(Estaciones_de_transito, modelo$residuals)) +
geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
theme_bw()
plot6 <- ggplot(data = datos, aes(Lugar_de_trabajo, modelo$residuals)) +
geom_point() + geom_smooth(color = "firebrick") + geom_hline(yintercept = 0) +
theme_bw()
plot7 <- ggplot(data = datos, aes(Zona_residencial, 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 5: Graficos de dispersión de las variables
Distribución Normal de los residuos
qqnorm(modelo$residuals)
qqline(modelo$residuals)