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/200816COVID19MEXICO_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"))

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	145,896.00	61,453.00	21,596.00	12.40	13.20	38.05
EPOC	16,375.00	5,298.00	2,696.00	1.39	1.14	4.75
ASMA	34,445.00	12,648.00	1,148.00	2.93	2.72	2.02
INMUSUPR	15,575.00	4,599.00	1,452.00	1.32	0.99	2.56
HIPERTENSION	191,017.00	78,081.00	25,014.00	16.23	16.78	44.07
OTRA_COM	30,147.00	10,103.00	2,956.00	2.56	2.17	5.21
CARDIOVASCULAR	23,675.00	7,803.00	3,015.00	2.01	1.68	5.31
OBESIDAD	186,611.00	83,086.00	13,914.00	15.86	17.85	24.52
RENAL_CRONICA	21,403.00	6,382.00	3,856.00	1.82	1.37	6.79
TABAQUISMO	95,572.00	32,898.00	4,544.00	8.12	7.07	8.01
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	86,159	7,856
MÉXICO	61,431	9,211
GUANAJUATO	26,625	1,376
TABASCO	25,790	2,317
VERACRUZ DE IGNACIO DE LA LLAVE	25,679	3,343
PUEBLA	24,383	3,015
NUEVO LEÓN	23,951	1,761
TAMAULIPAS	20,735	1,544
SONORA	19,972	2,380
COAHUILA DE ZARAGOZA	17,718	1,095
JALISCO	16,381	2,009
BAJA CALIFORNIA	15,352	2,923
SINALOA	14,495	2,547
SAN LUIS POTOSÍ	14,257	852
GUERRERO	13,254	1,552
YUCATÁN	12,571	1,129
OAXACA	12,358	1,145
MICHOACÁN DE OCAMPO	12,352	985
QUINTANA ROO	9,298	1,222
HIDALGO	8,729	1,317
CHIHUAHUA	6,581	1,027
BAJA CALIFORNIA SUR	6,330	265
CHIAPAS	6,072	1,038
TLAXCALA	5,643	863
DURANGO	5,317	374
CAMPECHE	5,190	679
QUERÉTARO	4,862	556
AGUASCALIENTES	4,812	314
MORELOS	4,652	906
NAYARIT	4,356	490
ZACATECAS	4,129	374
COLIMA	2,728	292

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

domingo, 16 de agosto 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