Descripción

Este es un análisis exploratorio de datos relacionados COVID-19 en México. Los datos son obtenidos del sitio https://datos.gob.mx. Primero se realiza un análisis de los datos a nivel nacional, posteriormente un análisis desglosado a nivel estatal.

Lectura y transformación de datos

El conjunto de datos ha sido descargado del siguiente sitio Web.

https://datos.gob.mx/busca/dataset/informacion-referente-a-casos-covid-19-en-mexico

covidmx <- read.csv("data_covid19_mexico/200902COVID19MEXICO_T.csv")
# Transform columns to class date
covidmx$ID_REGISTRO <- as.integer(covidmx$ID_REGISTRO)
covidmx$FECHA_ACTUALIZACION <- as.Date(covidmx$FECHA_ACTUALIZACION, format("%Y-%m-%d"))
covidmx$FECHA_INGRESO <- as.Date(covidmx$FECHA_INGRESO, format("%Y-%m-%d"))
covidmx$FECHA_SINTOMAS <- as.Date(covidmx$FECHA_SINTOMAS, format("%Y-%m-%d"))
covidmx$FECHA_DEF <- as.Date(covidmx$FECHA_DEF, format("%Y-%m-%d"))

Se cargan los paquetes necesarios.

library(ggplot2)
library(lubridate)
library(tidyverse)
library(lubridate)
library(gmodels)
library(readxl)
library(kableExtra)
library(reshape2)
plotscaption <- "oscarcastrolopez.github.io"

El conjunto de datos en formato csv ha sido previamente modificado y a cada variable categórica se le ha asignado su valor correspondiente. Esta tarea se hizo utilizando los diccionarios de datos disponibles en el siguiente sitio:

https://datos.gob.mx/busca/dataset/informacion-referente-a-casos-covid-19-en-mexico/resource/71233cf3-214f-4563-828b-b3c0213d0ae6

Los pasos realizados en la transformación de datos se encuentran en el siguiente enlace: Data wrangling before EDA.

Dentro de los archivos disponibles se encuentra el diccionario de datos con la descripción de cada variable y su formato. A continuación puede dar click en el siguiente enlace para mostrar u ocultar la descripción de cada variable.

Click para mostrar/ocultar detalle de las variables

Descripción de cada columna
Nº	NOMBRE DE VARIABLE	DESCRIPCIÓN DE VARIABLE	FORMATO O FUENTE
1	FECHA_ACTUALIZACION	La base de datos se alimenta diariamente, esta variable permite identificar la fecha de la ultima actualizacion.	AAAA-MM-DD
2	ID_REGISTRO	Número identificador del caso	TEXTO
3	ORIGEN	La vigilancia centinela se realiza a través del sistema de unidades de salud monitoras de enfermedades respiratorias (USMER). Las USMER incluyen unidades médicas del primer, segundo o tercer nivel de atención y también participan como USMER las unidades de tercer nivel que por sus características contribuyen a ampliar el panorama de información epidemiológica, entre ellas las que cuenten con especialidad de neumología, infectología o pediatría. (Categorías en Catalógo Anexo).	CATÁLOGO: ORIGEN
4	SECTOR	Identifica el tipo de institución del Sistema Nacional de Salud que brindó la atención.	CATÁLOGO: SECTOR
5	ENTIDAD_UM	Identifica la entidad donde se ubica la unidad medica que brindó la atención.	CATALÓGO: ENTIDADES
6	SEXO	Identifica al sexo del paciente.	CATÁLOGO: SEXO
7	ENTIDAD_NAC	Identifica la entidad de nacimiento del paciente.	CATALÓGO: ENTIDADES
8	ENTIDAD_RES	Identifica la entidad de residencia del paciente.	CATALÓGO: ENTIDADES
9	MUNICIPIO_RES	Identifica el municipio de residencia del paciente.	CATALÓGO: MUNICIPIOS
10	TIPO_PACIENTE	Identifica el tipo de atención que recibió el paciente en la unidad. Se denomina como ambulatorio si regresó a su casa o se denomina como hospitalizado si fue ingresado a hospitalización.	CATÁLOGO: TIPO_PACIENTE
11	FECHA_INGRESO	Identifica la fecha de ingreso del paciente a la unidad de atención.	AAAA-MM-DD
12	FECHA_SINTOMAS	Idenitifica la fecha en que inició la sintomatología del paciente.	AAAA-MM-DD
13	FECHA_DEF	Identifica la fecha en que el paciente falleció.	AAAA-MM-DD
14	INTUBADO	Identifica si el paciente requirió de intubación.	CATÁLOGO: SI_ NO
15	NEUMONIA	Identifica si al paciente se le diagnosticó con neumonía.	CATÁLOGO: SI_ NO
16	EDAD	Identifica la edad del paciente.	NÚMERICA EN AÑOS
17	NACIONALIDAD	Identifica si el paciente es mexicano o extranjero.	CATÁLOGO: NACIONALIDAD
18	EMBARAZO	Identifica si la paciente está embarazada.	CATÁLOGO: SI_ NO
19	HABLA_LENGUA_INDIG	Identifica si el paciente habla lengua índigena.	CATÁLOGO: SI_ NO
20	DIABETES	Identifica si el paciente tiene un diagnóstico de diabetes.	CATÁLOGO: SI_ NO
21	EPOC	Identifica si el paciente tiene un diagnóstico de EPOC.	CATÁLOGO: SI_ NO
22	ASMA	Identifica si el paciente tiene un diagnóstico de asma.	CATÁLOGO: SI_ NO
23	INMUSUPR	Identifica si el paciente presenta inmunosupresión.	CATÁLOGO: SI_ NO
24	HIPERTENSION	Identifica si el paciente tiene un diagnóstico de hipertensión.	CATÁLOGO: SI_ NO
25	OTRAS_COM	Identifica si el paciente tiene diagnóstico de otras enfermedades.	CATÁLOGO: SI_ NO
26	CARDIOVASCULAR	Identifica si el paciente tiene un diagnóstico de enfermedades cardiovasculares.	CATÁLOGO: SI_ NO
27	OBESIDAD	Identifica si el paciente tiene diagnóstico de obesidad.	CATÁLOGO: SI_ NO
28	RENAL_CRONICA	Identifica si el paciente tiene diagnóstico de insuficiencia renal crónica.	CATÁLOGO: SI_ NO
29	TABAQUISMO	Identifica si el paciente tiene hábito de tabaquismo.	CATÁLOGO: SI_ NO
30	OTRO_CASO	Identifica si el paciente tuvo contacto con algún otro caso diagnósticado con SARS CoV-2	CATÁLOGO: SI_ NO
31	RESULTADO	Identifica el resultado del análisis de la muestra reportado por el laboratorio de la Red Nacional de Laboratorios de Vigilancia Epidemiológica (INDRE, LESP y LAVE). (Catálogo de resultados diagnósticos anexo).	CATÁLOGO: RESULTADO
32	MIGRANTE	Identifica si el paciente es una persona migrante.	CATÁLOGO: SI_ NO
33	PAIS_NACIONALIDAD	Identifica la nacionalidad del paciente.	TEXTO, 99= SE IGNORA
34	PAIS_ORIGEN	Identifica el país del que partió el paciente rumbo a México.	TEXTO, 97= NO APLICA
35	UCI	Identifica si el paciente requirió ingresar a una Unidad de Cuidados Intensivos.	CATÁLOGO: SI_ NO

Información a nivel nacional

dailycases.df <- as.data.frame.matrix(table(covidmx$FECHA_INGRESO, covidmx$RESULTADO))
dailycases.df$Fecha <- as.Date(rownames(dailycases.df), format("%Y-%m-%d"))
rownames(dailycases.df) <- NULL
names(dailycases.df) <- c("pacientes.positivos", "pacientes.negativos", "pacientes.pendientes", "Fecha")
dailydeaths.df <- as.data.frame.matrix(table(covidmx$FECHA_DEF, covidmx$RESULTADO))
dailydeaths.df$Fecha <- as.Date(rownames(dailydeaths.df), format("%Y-%m-%d"))
rownames(dailydeaths.df) <- NULL
names(dailydeaths.df) <- c("fallecidos.negativos", "fallecidos.positivos", "fallecidos.pendientes", "Fecha")
daily.df <- merge(dailycases.df, dailydeaths.df, by="Fecha", all=T)
## The NAs are set to 0
daily.df[is.na(daily.df)] <- 0
## Cummulative variables of cases and deaths
daily.df$total.casos <- cumsum(daily.df$pacientes.positivos)
daily.df$total.fallecidos <- cumsum(daily.df$fallecidos.positivos)
rm(dailycases.df, dailydeaths.df)

Casos diarios

plot.cases <- function(graphsubtitle, startdate, enddate, date_breaks.p = "month", date_labels.p = "%b"){
  ggplot(data=subset(daily.df, subset=Fecha>=startdate) , aes(x=Fecha, y=pacientes.positivos)) +
    geom_line(size=1, color="orange") +
    scale_x_date(date_breaks = date_breaks.p, date_labels = date_labels.p)+
    labs(title = "Curva de casos diarios de COVID-19 en México", 
         subtitle = sublabel.tmp,
         caption = plotscaption,
         y="Casos",
         x="Fecha")+
    theme_bw()+
    theme(title = element_text(size=14, face="bold", colour = "black"),
          axis.text.y = element_text(size=11, face="bold", colour = "black"), 
          axis.text.x = element_text(size=11, face="bold", colour = "black"),
          legend.position = "bottom",
          legend.title = element_text(size = 14),
          legend.text = element_text(size = 13),
          legend.key.width = unit(1.5,"cm"))
}

Desde el Inicio

startdate <- min(daily.df$Fecha)
enddate <- max(daily.df$Fecha)
sublabel.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases(sublabel.tmp, startdate, enddate)

Últimos 3 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-3)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimos 2 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Último mes

startdate.tmp <- max(daily.df$Fecha) %m+% months(-1)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimas 2 semanas

startdate.tmp <- max(daily.df$Fecha) %m+% weeks(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases(sublabel.tmp, startdate.tmp, enddate, "day","%b %d")

Fallecidos diarios

plot.deaths <- function(graphsubtitle, startdate, enddate, date_breaks.p = "month", date_labels.p = "%b"){
  ggplot(data=subset(daily.df, subset=Fecha>=startdate) , aes(x=Fecha, y=fallecidos.positivos)) +
    geom_line(size=1, color="red") +
    scale_x_date(date_breaks = date_breaks.p, date_labels = date_labels.p)+
    labs(title = "Curva de fallecidos diarios de COVID-19 en México", 
         subtitle = sublabel.tmp,
         caption = plotscaption,
         y="Fallecidos",
         x="Fecha")+
    theme_bw()+
    theme(title = element_text(size=14, face="bold", colour = "black"),
          axis.text.y = element_text(size=11, face="bold", colour = "black"), 
          axis.text.x = element_text(size=11, face="bold", colour = "black"),
          legend.position = "bottom",
          legend.title = element_text(size = 14),
          legend.text = element_text(size = 13),
          legend.key.width = unit(1.5,"cm"))
}

Desde el Inicio

startdate <- min(daily.df$Fecha)
enddate <- max(daily.df$Fecha)
sublabel.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths(sublabel.tmp, startdate, enddate)

Últimos 3 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-3)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimos 2 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Último mes

startdate.tmp <- max(daily.df$Fecha) %m+% months(-1)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimas 2 semanas

startdate.tmp <- max(daily.df$Fecha) %m+% weeks(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths(sublabel.tmp, startdate.tmp, enddate, "day","%b %d")

Casos acumulados

plot.totalcases <- function(graphsubtitle, startdate, enddate, date_breaks.p = "month", date_labels.p = "%b"){
  ggplot(data=subset(daily.df, subset=Fecha>=startdate) , aes(x=Fecha, y=total.casos)) +
    geom_line(size=1, color="orange") +
    scale_x_date(date_breaks = date_breaks.p, date_labels = date_labels.p)+
    labs(title = "Curva de casos acumulados de COVID-19 en México", 
         subtitle = sublabel.tmp,
         caption = plotscaption,
         y="Casos",
         x="Fecha")+
    theme_bw()+
    theme(title = element_text(size=14, face="bold", colour = "black"),
          axis.text.y = element_text(size=11, face="bold", colour = "black"), 
          axis.text.x = element_text(size=11, face="bold", colour = "black"),
          legend.position = "bottom",
          legend.title = element_text(size = 14),
          legend.text = element_text(size = 13),
          legend.key.width = unit(1.5,"cm"))
}

Desde el Inicio

startdate <- min(daily.df$Fecha)
enddate <- max(daily.df$Fecha)
sublabel.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totalcases(sublabel.tmp, startdate, enddate)

Últimos 3 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-3)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totalcases(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimos 2 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totalcases(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Último mes

startdate.tmp <- max(daily.df$Fecha) %m+% months(-1)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totalcases(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimas 2 semanas

startdate.tmp <- max(daily.df$Fecha) %m+% weeks(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totalcases(sublabel.tmp, startdate.tmp, enddate, "day","%b %d")

Fallecidos acumulados

plot.totaldeaths <- function(graphsubtitle, startdate, enddate, date_breaks.p = "month", date_labels.p = "%b"){
  ggplot(data=subset(daily.df, subset=Fecha>=startdate) , aes(x=Fecha, y=total.fallecidos)) +
    geom_line(size=1, color="red") +
    scale_x_date(date_breaks = date_breaks.p, date_labels = date_labels.p)+
    labs(title = "Curva de fallecidos acumulados por COVID-19 en México", 
         subtitle = sublabel.tmp,
         caption = plotscaption,
         y="Fallecidos",
         x="Fecha")+
    theme_bw()+
    theme(title = element_text(size=14, face="bold", colour = "black"),
          axis.text.y = element_text(size=11, face="bold", colour = "black"), 
          axis.text.x = element_text(size=11, face="bold", colour = "black"),
          legend.position = "bottom",
          legend.title = element_text(size = 14),
          legend.text = element_text(size = 13),
          legend.key.width = unit(1.5,"cm"))
}

Desde el Inicio

startdate <- min(daily.df$Fecha)
enddate <- max(daily.df$Fecha)
sublabel.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totaldeaths(sublabel.tmp, startdate, enddate)

Últimos 3 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-3)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totaldeaths(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimos 2 meses

startdate.tmp <- max(daily.df$Fecha) %m+% months(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totaldeaths(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Último mes

startdate.tmp <- max(daily.df$Fecha) %m+% months(-1)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totaldeaths(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimas 2 semanas

startdate.tmp <- max(daily.df$Fecha) %m+% weeks(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.totaldeaths(sublabel.tmp, startdate.tmp, enddate, "day","%b %d")

Casos y muertes COVID-19 semanales

week.df <- daily.df %>% 
  group_by(week = week(Fecha)) %>%
  summarise(mean_new_cases = mean(pacientes.positivos),
            n = n(), 
            loCI_new_cases = ci(pacientes.positivos)[2], 
            hiCI_new_cases = ci(pacientes.positivos)[3], 
            mean_new_deaths = mean(fallecidos.positivos), 
            loCI_new_deaths = ci(fallecidos.positivos)[2], 
            hiCI_new_deaths = ci(fallecidos.positivos)[3], 
            total_new_cases = sum(pacientes.positivos), 
            total_new_deaths = sum(fallecidos.positivos))
rm(daily.df)

Promedio semanal de casos

subtitle.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
ggplot(data=week.df, aes(x=as.factor(week),y=mean_new_cases))+
  geom_bar(stat = 'identity', aes(fill = mean_new_cases)) +
  geom_errorbar(aes(ymin=loCI_new_cases, ymax=hiCI_new_cases), width=.2,
                position=position_dodge(.9)) +
  xlab("Semana")+
  ylab("Promedio semanal de casos ± IC 95%")+
  labs(title="Promedio semanal de casos de COVID-19 en México",
       subtitle = subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Casos", low = "green", high = "orange")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Promedio semanal de muertes

ggplot(data=week.df, aes(x=as.factor(week),y=mean_new_deaths))+
  geom_bar(stat = 'identity', aes(fill = mean_new_deaths)) +
  geom_errorbar(aes(ymin=loCI_new_deaths, ymax=hiCI_new_deaths), width=.2,
                position=position_dodge(.9)) +
  xlab("Semana")+
  ylab("Promedio semanal de muertes ± IC 95%")+
  labs(title="Promedio semanal de muertes por COVID-19 en México",
       subtitle = subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Muertes", low = "green", high = "red")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Casos totales por semana

ggplot(data=week.df, aes(x=as.factor(week),y=total_new_cases))+
  geom_bar(stat = 'identity', aes(fill = total_new_cases)) +
  xlab("Semana")+
  ylab("Casos totales por semana")+
  labs(title="Casos totales de COVID-19 por semana en México",
       subtitle = subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Casos totales", low = "green", high = "orange")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Muertes totales por semana

ggplot(data=week.df, aes(x=as.factor(week),y=total_new_deaths))+
  geom_bar(stat = 'identity', aes(fill = total_new_deaths)) +
  xlab("Semana")+
  ylab("Muertes totales por semana")+
  labs(title="Muertes totales por COVID-19 por semana en México",
       subtitle=subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Muertes totales", low = "green", high = "red")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Información General

Distribución de acuerdo a la edad

meanpersexo <- aggregate(covidmx$EDAD, list(covidmx$SEXO), mean)
names(meanpersexo) <- c("SEXO", "Mean")
meanpersexo$Mean <- round(meanpersexo$Mean,2)
subtitle.text <- paste("Promedio de edad en general:", round( mean(covidmx$EDAD),2)) 
ggplot(covidmx, aes(x=EDAD, fill=SEXO)) + 
  geom_histogram(color="black", binwidth = 5)+
  scale_fill_manual(values=c("cornflowerblue", "hotpink"))+
  scale_x_continuous(breaks = seq(min(covidmx$EDAD), max(covidmx$EDAD), 20))+
  facet_wrap(~SEXO, ncol = 2)+
  geom_vline(data=meanpersexo, aes(xintercept=Mean, colour=SEXO),
             color="black", linetype="dashed", size=1) +
  geom_text(y=70000, aes(x=Mean+10, label=paste("Promedio:",Mean)),
            data=meanpersexo[meanpersexo$SEXO=="HOMBRE",]) +
  geom_text(y=70000, aes(x=Mean+10, label=paste("Promedio:",Mean)),
            data=meanpersexo[meanpersexo$SEXO=="MUJER",]) +
 labs(title="Distribución de edad de los datos COVID-19 México - desglose por sexo", 
      subtitle = subtitle.text, 
      x="Edad", y = "Conteo")+
  theme_bw() +
  theme(legend.position="bottom",
        title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Cantidad de pacientes registrados y enfermedades que presentan

indicadorlabel <- c('Total Pacientes', 'Positivo SARS-CoV-2',
                   paste0(toupper(substr(tolower(colnames(covidmx[,21:30])), 1, 1)), 
                          substr(tolower(colnames(covidmx[,21:30])), 2, 
                                 nchar(tolower(colnames(covidmx[,21:30]))))))
indicadorlabel[8] <- "Otra Comorbilidad"
indicadorlabel[6] <- "Inmunosupresión"
indicadorlabel[11] <- "Insuf. Renal"
indicadorconteo <- c()
indicadorconteo[1] <- nrow(covidmx)
indicadorconteo[2] <- nrow(subset(covidmx, subset=RESULTADO=='Positivo SARS-CoV-2'))

indicadorconteo <- c(indicadorconteo, melt(colSums(covidmx[21:30] == "SI"))[[1]])
enfermedadesPacientes <- data.frame( 'Indicador' =indicadorlabel, 'Conteo' = indicadorconteo)
enfermedadesPacientes <- enfermedadesPacientes[order(-enfermedadesPacientes$Conteo),]
rownames(enfermedadesPacientes) <- NULL

porcentajes <- (100 *enfermedadesPacientes$Conteo[2:12]) / enfermedadesPacientes$Conteo[1]
porcentajes <- round(porcentajes, 2)
porcentajes <- formatC(porcentajes, 
                              format="f", 
                              big.mark=",", 
                              digits=2)
etiqueta.tmp <- paste0(label=formatC(enfermedadesPacientes$Conteo[2:12], 
                              format="f", 
                              big.mark=",", 
                              digits=0),
                      " - ",
                      porcentajes,
                      "%")
ggplot(enfermedadesPacientes[2:12,], aes(x=reorder(Indicador, Conteo), y=Conteo, fill=Indicador)) + 
  geom_bar(stat = "identity", position=position_dodge(), colour="black", show.legend = FALSE) + 
  coord_flip() + 
  labs(title="Total de pacientes registrados y totales de cada enfermedad presente", 
        caption = plotscaption,
        subtitle = paste0('Total de pacientes registrados: ', 
                          formatC(enfermedadesPacientes$Conteo[1], 
                              format="f", 
                              big.mark=",", 
                              digits=0)), 
        x="Cantidad de pacientes con:", y = "Conteo") + 
  geom_text(aes(y=max(Conteo)+38000, 
                label=etiqueta.tmp,
                fontface="bold"), 
            color="black")+
  ylim(0, 570000)+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

## Warning: Removed 1 rows containing missing values (geom_bar).

## Warning: Removed 11 rows containing missing values (geom_text).

Enfermedades que presentan los pacientes en general y los pacientes con COVID-19 fallecidos y no fallecidos

covidmx.tmp <- subset(covidmx, subset=RESULTADO=='Positivo SARS-CoV-2', )
totalenfermos <- nrow(covidmx.tmp)
totalfallecidos <- nrow(subset(covidmx.tmp, subset=!is.na(FECHA_DEF)))
totalnofallecidos <- nrow(subset(covidmx.tmp, subset=is.na(FECHA_DEF)))
# Get totals of deceased people
deceased.tmp <- melt(colSums(subset(covidmx.tmp, subset = !is.na(FECHA_DEF))[21:30] == "SI"))
deceased.tmp$Estado <- 'Fallecidos'
deceased.tmp$Enfermedad <- rownames(deceased.tmp)
# Get totals of not deceased people
notdeceased.tmp <- melt(colSums(subset(covidmx.tmp, subset = is.na(FECHA_DEF))[21:30] == "SI"))
notdeceased.tmp$Estado <- 'No Fallecidos'
notdeceased.tmp$Enfermedad <- rownames(notdeceased.tmp)

enfermos.agg <- rbind(deceased.tmp, notdeceased.tmp)
names(enfermos.agg)[1] <- "Conteo"
rownames(enfermos.agg) <- NULL
enfermos.agg <- enfermos.agg[, c('Estado', 'Enfermedad', 'Conteo')]
enfermos.table <- cbind(deceased.tmp, notdeceased.tmp)
names(enfermos.table)[c(1,4)] <- c("Fallecidos", "No.Fallecidos")
enfermos.table$Pacientes <- melt(colSums(covidmx[21:30] == "SI"))[[1]]
rownames(enfermos.table) <- NULL
enfermos.table <- enfermos.table[, c(3,7,4,1)]
rm(covidmx.tmp, deceased.tmp, notdeceased.tmp)

enfermos.table$Pacientes.Porcentaje <- (100 * enfermos.table$Pacientes) / nrow(covidmx)
enfermos.table$No.Fallecidos.Porcentaje <- (100 * enfermos.table$No.Fallecidos) / totalnofallecidos
enfermos.table$Fallecidos.Porcentaje <- (100 * enfermos.table$Fallecidos) / totalfallecidos
enfermos.table[,5:7] <- round(enfermos.table[,5:7], 2)
                              
tablecolnames <- c("Enfermedad", "Total pacientes", 
                   "COVID-19 No fallecidos", "COVID-19 Fallecidos",
                   "% Total pacientes",
                   "% COVID-19 No fallecidos",
                   "% COVID-19 Fallecidos")

enfermos.table %>% mutate_if(is.numeric, formatC, format="f", digits=2, big.mark=",") %>%
    kable(format = "html", align = "lrrrrrr", col.names=tablecolnames,
      caption="Enfermedades que presentan los pacientes en general y los que dieron positivo a SARS-CoV-2") %>%   kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = T) %>%
  footnote(general = "Obtención de los porcentajes.",
           number = c("% Total pacientes: Porcentaje de pacientes que presentan la enfermedad indicada en el renglón del total de pacientes registrados.",
             "% COVID-19 No fallecidos: Porcentaje de pacientes que presentan la enfermedad indicada en el renglón, que no han fallecido y dieron positivo a SARS-CoV-2.", 
             "% COVID-19 Fallecidos: Porcentaje de pacientes que presentan la enfermedad indicada en el renglón, que fallecieron y dieron positivo a SARS-CoV-2.")
           )

Enfermedades que presentan los pacientes en general y los que dieron positivo a SARS-CoV-2
Enfermedad	Total pacientes	COVID-19 No fallecidos	COVID-19 Fallecidos	% Total pacientes	% COVID-19 No fallecidos	% COVID-19 Fallecidos
DIABETES	169,440.00	71,000.00	25,124.00	12.31	13.02	38.17
EPOC	18,644.00	6,059.00	3,154.00	1.35	1.11	4.79
ASMA	39,872.00	14,739.00	1,347.00	2.90	2.70	2.05
INMUSUPR	17,611.00	5,196.00	1,657.00	1.28	0.95	2.52
HIPERTENSION	222,577.00	90,640.00	29,313.00	16.17	16.63	44.54
OTRA_COM	34,333.00	11,623.00	3,404.00	2.49	2.13	5.17
CARDIOVASCULAR	27,087.00	8,894.00	3,510.00	1.97	1.63	5.33
OBESIDAD	215,609.00	96,422.00	16,118.00	15.67	17.69	24.49
RENAL_CRONICA	24,519.00	7,265.00	4,536.00	1.78	1.33	6.89
TABAQUISMO	111,801.00	38,728.00	5,245.00	8.12	7.10	7.97
Note:
Obtención de los porcentajes.
¹ % Total pacientes: Porcentaje de pacientes que presentan la enfermedad indicada en el renglón del total de pacientes registrados.
² % COVID-19 No fallecidos: Porcentaje de pacientes que presentan la enfermedad indicada en el renglón, que no han fallecido y dieron positivo a SARS-CoV-2.
³ % COVID-19 Fallecidos: Porcentaje de pacientes que presentan la enfermedad indicada en el renglón, que fallecieron y dieron positivo a SARS-CoV-2.

#ggplot(enfermos.agg, aes(x=Estado, y=Conteo, fill=Enfermedad)) + 
#   geom_bar(position="dodge", stat="identity")

Porcentaje de enfermedades que presentan los pacientes en general, y los pacientes con COVID-19 fallecidos y no fallecidos

enfermos.lf <- melt(enfermos.table[,c(1, 5, 6,7)])
enfermos.lf$Enfermedad <- ifelse(enfermos.lf$Enfermedad=='OTRA_COM', 
                                 'OTRA COMORB.', 
                                 enfermos.lf$Enfermedad)
enfermos.lf$Enfermedad <- ifelse(enfermos.lf$Enfermedad=='RENAL_CRONICA', 
                                 'INSUF. RENAL', 
                                 enfermos.lf$Enfermedad)
enfermos.lf$Enfermedad <- ifelse(enfermos.lf$Enfermedad=='INMUSUPR', 
                                 'INMUSUPRESIÓN', 
                                 enfermos.lf$Enfermedad)
ggplot(enfermos.lf, aes(x=Enfermedad, y=value, fill=variable)) + 
  geom_bar(position="dodge", stat="identity") +
  labs(title="Porcentaje de enfermedades de los pacientes registrados, de pacientes positivos SARS-CoV-2 fallecidos y no fallecidos", 
        caption = plotscaption,
        subtitle = "",
       x = "Enfermedad",
       y = "Porcentaje") +
  scale_fill_discrete(name = "Grupo", labels=c("Total de Pacientes Registrados", 
                                                "Pacientes COVID-19 No Fallecidos",
                                                "Pacientes COVID-19 Fallecidos"))+
  #scale_fill_manual(values=c("cornflowerblue", "orange", "red")) +
  geom_text(aes(y=value+0.5, 
                label=paste0(round(value,0), "%"),
                fontface="bold"), 
            color="black",
            position = position_dodge(width = 1)) +
  theme_bw() +
  theme(legend.position="bottom",
        title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

rm(columnInformation, enfermedadesPacientes, enfermos.agg, enfermos.lf, enfermos.table, meanpersexo, week.df)

Información a nivel estatal

daily.estate.patients <- covidmx %>% 
                          group_by(FECHA_INGRESO, ENTIDAD_RES) %>% 
                          tally(name='patients')
daily.estate.cases <- covidmx %>% 
                          filter(RESULTADO == 'Positivo SARS-CoV-2') %>%
                          group_by(FECHA_INGRESO, ENTIDAD_RES) %>% 
                          tally(name='cases')
daily.estate.deaths <- covidmx %>% 
                          filter(RESULTADO == 'Positivo SARS-CoV-2') %>%
                          drop_na(FECHA_DEF) %>% 
                          group_by(FECHA_DEF, ENTIDAD_RES) %>% 
                          tally(name='deaths')
daily.estate.df <- merge(daily.estate.patients, daily.estate.cases, all=T)
rm(daily.estate.patients, daily.estate.cases)
daily.estate.df <- merge(daily.estate.df, daily.estate.deaths, 
                         by.x = c("FECHA_INGRESO","ENTIDAD_RES"),
                         by.y = c("FECHA_DEF","ENTIDAD_RES"),
                         all=TRUE)
rm(daily.estate.deaths)
daily.estate.df[,c(3,4,5)][is.na(daily.estate.df[,c(3,4,5)])] <- 0

names(daily.estate.df) <- c('Fecha', 'Entidad.Federativa', 'Pacientes', 'Casos', 'Fallecidos')

totals.estate.df <- daily.estate.df[,-1] %>%
                    group_by(Entidad.Federativa) %>%
                    summarise_each(funs(sum))

totals.estate.df[,-2][order(-totals.estate.df$Casos),] %>% 
  mutate_if(is.numeric, formatC, format="f", digits=0, big.mark=",") %>% 
  kable(format = "html", align = "lrr", 
        caption="Información de casos y fallecidos por COVID-19 por estado ordenado por cantidad de casos.") %>% 
  kable_styling(bootstrap_options = c("striped", "hover", "condensed", "responsive"), 
                full_width = T)

Información de casos y fallecidos por COVID-19 por estado ordenado por cantidad de casos.
Entidad.Federativa	Casos	Fallecidos
CIUDAD DE MÉXICO	100,394	8,541
MÉXICO	68,844	10,206
GUANAJUATO	32,376	2,185
NUEVO LEÓN	29,951	2,319
VERACRUZ DE IGNACIO DE LA LLAVE	28,734	3,801
TABASCO	28,626	2,559
PUEBLA	27,348	3,544
TAMAULIPAS	24,870	1,800
COAHUILA DE ZARAGOZA	22,074	1,426
SONORA	21,713	2,635
JALISCO	20,794	2,503
SAN LUIS POTOSÍ	18,514	1,210
BAJA CALIFORNIA	17,069	3,216
SINALOA	16,385	2,831
MICHOACÁN DE OCAMPO	15,416	1,247
YUCATÁN	15,074	1,315
GUERRERO	15,033	1,717
OAXACA	13,905	1,291
HIDALGO	10,549	1,612
QUINTANA ROO	10,461	1,419
CHIHUAHUA	7,968	1,167
BAJA CALIFORNIA SUR	7,873	366
QUERÉTARO	6,606	706
DURANGO	6,604	466
TLAXCALA	6,533	979
CHIAPAS	6,281	1,068
AGUASCALIENTES	5,754	410
CAMPECHE	5,619	750
ZACATECAS	5,460	517
MORELOS	5,277	991
NAYARIT	5,064	608
COLIMA	3,788	411

Casos diarios por entidad federativa

plot.cases.estate <- function(graphsubtitle, startdate, enddate, date_breaks.p = "month", date_labels.p = "%b"){
  ggplot(data=subset(daily.estate.df, subset=Fecha>=startdate) , 
         aes(x=Fecha, y=Casos)) +
    geom_line(size=1, color="orange") +
    facet_wrap(~Entidad.Federativa, ncol = 4) +
    scale_x_date(date_breaks = date_breaks.p, date_labels = date_labels.p)+
    labs(title = "Curva de casos diarios de COVID-19 en México por entidad federativa", 
         subtitle = sublabel.tmp,
         caption = plotscaption,
         y="Casos",
         x="Fecha")+
    theme_bw()+
    theme(title = element_text(size=14, face="bold", colour = "black"),
          axis.text.y = element_text(size=11, face="bold", colour = "black"), 
          axis.text.x = element_text(size=11, face="bold", colour = "black"),
          legend.position = "bottom",
          legend.title = element_text(size = 14),
          legend.text = element_text(size = 13),
          legend.key.width = unit(1.5,"cm"))
}

Desde el Inicio

startdate <- min(daily.estate.df$Fecha)
enddate <- max(daily.estate.df$Fecha)
sublabel.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases.estate(sublabel.tmp, startdate, enddate)

Último mes

startdate.tmp <- max(daily.estate.df$Fecha) %m+% months(-1)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases.estate(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimas 2 semanas

startdate.tmp <- max(daily.estate.df$Fecha) %m+% weeks(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.cases.estate(sublabel.tmp, startdate.tmp, enddate, "day","%d")

Fallecidos diarios por entidad federativa

plot.deaths.estate <- function(graphsubtitle, startdate, enddate, date_breaks.p = "month", date_labels.p = "%b"){
  ggplot(data=subset(daily.estate.df, subset=Fecha>=startdate) , aes(x=Fecha, y=Fallecidos)) +
    geom_line(size=1, color="red") +
    facet_wrap(~Entidad.Federativa, ncol = 4) +
    scale_x_date(date_breaks = date_breaks.p, date_labels = date_labels.p)+
    labs(title = "Curva de fallecidos diarios de COVID-19 en México por entidad federativa", 
         subtitle = sublabel.tmp,
         caption = plotscaption,
         y="Fallecidos",
         x="Fecha")+
    theme_bw()+
    theme(title = element_text(size=14, face="bold", colour = "black"),
          axis.text.y = element_text(size=11, face="bold", colour = "black"), 
          axis.text.x = element_text(size=11, face="bold", colour = "black"),
          legend.position = "bottom",
          legend.title = element_text(size = 14),
          legend.text = element_text(size = 13),
          legend.key.width = unit(1.5,"cm"))
}

Desde el Inicio

startdate <- min(daily.estate.df$Fecha)
enddate <- max(daily.estate.df$Fecha)
sublabel.tmp <- paste("Rango:", format(startdate, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths.estate(sublabel.tmp, startdate, enddate)

Último mes

startdate.tmp <- max(daily.estate.df$Fecha) %m+% months(-1)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths.estate(sublabel.tmp, startdate.tmp, enddate, "week","%b %d")

Últimas 2 semanas

startdate.tmp <- max(daily.estate.df$Fecha) %m+% weeks(-2)
sublabel.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
plot.deaths.estate(sublabel.tmp, startdate.tmp, enddate, "day","%d")

Casos y muertes COVID-19 semanales por entidad federativa

week.estate.df <- daily.estate.df %>% 
  group_by(week = week(Fecha), Entidad.Federativa) %>%
  summarise(mean_new_cases = mean(Casos),
            n = n(), 
            loCI_new_cases = ci(Casos)[2], 
            hiCI_new_cases = ci(Casos)[3], 
            mean_new_deaths = mean(Fallecidos), 
            loCI_new_deaths = ci(Fallecidos)[2], 
            hiCI_new_deaths = ci(Fallecidos)[3], 
            total_new_cases = sum(Casos), 
            total_new_deaths = sum(Fallecidos))
rm(daily.estate.df)
#We remove weeks with 0 cases 
week.estate.df <- week.estate.df[week.estate.df$total_new_deaths > 0, ]

Promedio semanal de casos por entidad federativa

startdate.tmp <- ymd( "2020-01-01" ) + lubridate::weeks( week.estate.df[1,1] - 1 )
subtitle.tmp <- paste("Rango:", format(startdate.tmp, "%d/%m/%Y"),"-", format(enddate, "%d/%m/%Y"))
ggplot(data=week.estate.df, aes(x=as.factor(week),y=mean_new_cases))+
  geom_bar(stat = 'identity', aes(fill = mean_new_cases)) +
  facet_wrap(~Entidad.Federativa, ncol = 4) +
  xlab("Semana")+
  ylab("Promedio semanal de casos ± IC 95%")+
  labs(title="Promedio semanal de casos de COVID-19 en México por entidad federativa",
       subtitle = subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Casos", low = "green", high = "orange")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Promedio semanal de muertes por entidad federativa

ggplot(data=week.estate.df, aes(x=as.factor(week),y=mean_new_deaths))+
  geom_bar(stat = 'identity', aes(fill = mean_new_deaths)) +
  facet_wrap(~Entidad.Federativa, ncol = 4) +
  xlab("Semana")+
  ylab("Promedio semanal de muertes ± IC 95%")+
  labs(title="Promedio semanal de muertes por COVID-19 en México por entidad federativa",
       subtitle = subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Muertes", low = "green", high = "red")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Casos totales por semana por entidad federativa

ggplot(data=week.estate.df, aes(x=as.factor(week),y=total_new_cases))+
  geom_bar(stat = 'identity', aes(fill = total_new_cases)) +
  facet_wrap(~Entidad.Federativa, ncol = 4) +
  xlab("Semana")+
  ylab("Casos totales por semana")+
  labs(title="Casos totales de COVID-19 por semana en México por entidad federativa",
       subtitle = subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Casos totales", low = "green", high = "orange")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Muertes totales por semana por entidad federativa

ggplot(data=week.estate.df, aes(x=as.factor(week),y=total_new_deaths))+
  geom_bar(stat = 'identity', aes(fill = total_new_deaths)) +
  facet_wrap(~Entidad.Federativa, ncol = 4) +
  xlab("Semana")+
  ylab("Muertes totales por semana")+
  labs(title="Muertes totales por COVID-19 por semana en México por entidad federativa",
       subtitle=subtitle.tmp,
       caption = plotscaption)+
  scale_fill_gradient(name="Muertes totales", low = "green", high = "red")+
  theme_bw()+
  theme(title = element_text(size=14, face="bold", colour = "black"),
        axis.text.y = element_text(size=11, face="bold", colour = "black"),
        axis.text.x = element_text(size=11, face="bold", colour = "black"))

Análisis exploratorio de datos (EDA) SARS-CoV-2 México

Oscar Castro

miércoles, 02 de septiembre de 2020

Descripción

Lectura y transformación de datos

Click para mostrar/ocultar detalle de las variables

Información a nivel nacional

Casos diarios

Desde el Inicio

Últimos 3 meses

Últimos 2 meses

Último mes

Últimas 2 semanas

Fallecidos diarios

Desde el Inicio

Últimos 3 meses

Últimos 2 meses

Último mes

Últimas 2 semanas

Casos acumulados

Desde el Inicio

Últimos 3 meses

Últimos 2 meses

Último mes

Últimas 2 semanas

Fallecidos acumulados

Desde el Inicio

Últimos 3 meses

Últimos 2 meses

Último mes

Últimas 2 semanas

Casos y muertes COVID-19 semanales

Promedio semanal de casos

Promedio semanal de muertes

Casos totales por semana

Muertes totales por semana

Información General

Distribución de acuerdo a la edad

Cantidad de pacientes registrados y enfermedades que presentan

Enfermedades que presentan los pacientes en general y los pacientes con COVID-19 fallecidos y no fallecidos

Porcentaje de enfermedades que presentan los pacientes en general, y los pacientes con COVID-19 fallecidos y no fallecidos

Información a nivel estatal

Casos diarios por entidad federativa

Desde el Inicio

Último mes

Últimas 2 semanas

Fallecidos diarios por entidad federativa

Desde el Inicio

Último mes

Últimas 2 semanas

Casos y muertes COVID-19 semanales por entidad federativa

Promedio semanal de casos por entidad federativa

Promedio semanal de muertes por entidad federativa

Casos totales por semana por entidad federativa

Muertes totales por semana por entidad federativa