Covid19 En México

Este documento muestra una estimación del número de hospitalizados y de muertes debido a COVID-19.

Los datos son extraídos de los Datos Abiertos - Dirección General de Epidemiología de la secretaria de salud de México.

https://www.gob.mx/salud/documentos/datos-abiertos-152127

Los datos del archivo .csv son importados a R y se escogen solamente los datos de pacientes con COVID-19.

Se hacen cuatro tipos de análisis:

  1. Tendencias de hospitalización en todo México

  2. Tendencias de defunciones para todo México

  3. Tendencias de pacientes hospitalizados por entidad federativa

  4. Observación de los nuevos hospitalización en las últimas dos semanas por cada 100,000 habitantes

Para cada uno de los análisis se estima los intervalos de confianza de cuándo será el pico de hospitalizados diarios y el pico de defunciones debido al COVID-19

Las predicciones están basadas en asumir que existe una población finita que puede ser infectada.
Para este caso se asume que:

  1. La población urbana de México es la única que está en riego.
  2. Asumimos que solo el 70% se va a exponer al virus en la primera ola.
  3. El 10% de los que son expuestos se contagian con el virus
  4. El 20% tiene síntomas
  5. De este 20% solamente el 15% requiere hospitalización
  6. La razón de defunción se estima con base en los datos

Con estas suposiciones se hacen las predicciones de esta página.

Nota 6/1/2020 Agregé dos gráficas al final. Una contiene la estimación de los picos por el número de casos esperados y la última ordena los estados desde el más alto riesgo al de menor riesgo. Además agrege la gráfica de cuantos eventos nuevos hay cada día.

Nota 5/28/2020 Se cambió el porcentaje de infectados de 30% a 50% Nota 7/13/2020 Se cambió el porcentaje de infectados de 50% a 70%

Nota: Este análisis es un esfuerzo personal para estimar los picos de nuevas hospitalizaciones y defunciones en México. Este trabajo no es patrocinado por ninguna sociedad civil, ni el gobierno federal ni estatal y solo representa un interés único en predecir el comportamiento del COVID-19. Las predicciones dependen de muchos factores que no estoy considerando y por tanto cambian día con día.

Nota de responsabilidad: El contenido de este sitio web es ESTRICTAMENTE SOLO para fines educativos y de investigación y puede contener errores. El modelo y los datos son inexactos a las realidades complejas, evolutivas y heterogéneas de diferentes estados. Las predicciones son inciertas por naturaleza. Los lectores deben tomar cualquier predicción con precaución. El exceso de optimismo basado en algunas fechas de picos previstas es peligroso porque puede relajar nuestras medidas y controles y provocar que la infección aumente y esto debe evitarse.

Adaptado de: https://ddi.sutd.edu.sg/

Cargando Los Datos

COVID19MEXICO <- read.csv("../Data/datos_abiertos_covid19/200720COVID19MEXICO.csv",
                           na.strings="99",
                          stringsAsFactors=FALSE)
PoblacionMexico <- read.delim2("~/GitHub/COVID19-Monitor/Data/datos_abiertos_covid19/PoblacionMexico.txt", stringsAsFactors=FALSE, encoding = 'UTF-8')

Las funciones de ajuste a modelos logisticos

Estos funciones estan en:

https://github.com/joseTamezPena/COVID_Forecasting

source('~/GitHub/COVIDTrends/COVID_Forecasting/logfunctions.r')
source('~/GitHub/COVIDTrends/COVID_Forecasting/PlotCoVID.r', encoding = 'UTF-8')

Preparando la Información

colnamesMexico <- colnames(COVID19MEXICO)
varnames <- c("SEXO","TIPO_PACIENTE","FECHA_INGRESO","FECHA_SINTOMAS","FECHA_DEF","INTUBADO","NEUMONIA","EDAD","EMBARAZO","DIABETES","EPOC","ASMA","INMUSUPR","HIPERTENSION","OTRA_COM","CARDIOVASCULAR","OBESIDAD","RENAL_CRONICA","TABAQUISMO","OTRO_CASO","RESULTADO","UCI")
varnames[!(varnames %in% colnamesMexico)]
#> character(0)

table(COVID19MEXICO[COVID19MEXICO$RESULTADO==1,"UCI"])
#> 
#>      1      2     97 
#>   8153  91067 250068
table(COVID19MEXICO[COVID19MEXICO$RESULTADO==1,"FECHA_DEF"] != "9999-99-99" )
#> 
#>  FALSE   TRUE 
#> 309911  39485
table(COVID19MEXICO[COVID19MEXICO$RESULTADO==1,"TIPO_PACIENTE"] )
#> 
#>      1      2 
#> 250068  99328

totalPopulation <- sum(as.numeric(PoblacionMexico$X2020.Total))*0.8
factorHospital <- 0.70*0.10*0.20*0.15;
expectedHospital <- totalPopulation*factorHospital;

Analisis los pacientes diagnosticados con COVID-19 y hospitalizados

par(mfrow=c(1,1),cex=0.9,mar=c(6,4,4,5))

hospitalCovidPatient <- subset(COVID19MEXICO, RESULTADO == 1 & TIPO_PACIENTE == 2)
dateofEvent <- as.Date(hospitalCovidPatient$FECHA_INGRESO)
dateofEvent2 <- as.Date(hospitalCovidPatient$FECHA_SINTOMAS)
dateofEvent <- pmax(dateofEvent,dateofEvent2)

startDate <- min(dateofEvent)
currentdate <- max(dateofEvent)
hcurrentdate <- currentdate

deltadays <- dateofEvent-startDate
tb <- table(deltadays)

totalHospital <- numeric(max(deltadays)+1)
hospitaldates <-  rep(startDate,length(totalHospital))
totalHospital[1] <- tb[1];
currendelta <- 2
i <- 2
for ( i in 2:length(totalHospital))
{
  totalHospital[i] <- totalHospital[i - 1]
  hospitaldates[i] <- hospitaldates[i] + i-1
  if (i == (as.numeric(names(tb)[currendelta])+1))
  {
    totalHospital[i] <- totalHospital[i] + tb[currendelta]
    currendelta <- currendelta + 1;
  }
}


plotCovid(totalHospital,"Hospitalización","Hospitalización en México",expectedHospital,startDate,currentdate)

Analysis de defunciones debidas a COVID-19

par(mfrow=c(1,1),cex=0.9,mar=c(6,4,4,5))

fatalityCovidPatient <- subset(COVID19MEXICO, RESULTADO==1 & FECHA_DEF != "9999-99-99")
dateofEvent <- as.Date(fatalityCovidPatient$FECHA_DEF)
startDate <- min(dateofEvent)
currentdate <- max(dateofEvent)


deltadays <- dateofEvent-min(dateofEvent)
startDate <- min(dateofEvent)
tb <- table(deltadays)

totaldeath <- numeric(max(deltadays)+1)
fatalitiesdates <-  rep(startDate,length(totaldeath))
totaldeath[1] <- tb[1];
currendelta <- 2
for ( i in 2:length(totaldeath))
{
  totaldeath[i] <- totaldeath[i - 1]
  if (i == (as.numeric(names(tb)[currendelta])+1))
  {
    totaldeath[i] <- totaldeath[i] + tb[currendelta]
    fatalitiesdates[i] <- fatalitiesdates[i] + i-1
    currendelta <- currendelta + 1;
  }
}

expectedFatalities <- expectedHospital*max(totaldeath)/max(totalHospital)
plotCovid(totaldeath,"Defunciones","Defunciones en México",expectedFatalities,startDate,currentdate)

Analisis los pacientes diagnosticados con COVID-19 y hospitalizados por regíon

ID = 27
par(mfrow=c(2,2),cex=0.45,mar=c(6,4,4,5))
peakRange <- list();
lasttwoweeks <- numeric(32);
for (ID in 1:32)
{
  
  expectedHospital <- as.numeric(PoblacionMexico[ID,"X2020.Total"])*factorHospital;
  statename <- PoblacionMexico[ID,"Estados.Unidos.Mexicanos"]

  hospitalCovidPatient <- subset(COVID19MEXICO, RESULTADO == 1 & TIPO_PACIENTE == 2 & ENTIDAD_NAC == ID)
  dateofEvent <- as.Date(hospitalCovidPatient$FECHA_INGRESO)
  dateofEvent2 <- as.Date(hospitalCovidPatient$FECHA_SINTOMAS)
  dateofEvent <- pmax(dateofEvent,dateofEvent2)
  
  startDate <- min(dateofEvent)
  currentdate <- max(dateofEvent)
  
  deltadays <- dateofEvent-startDate
  tb <- table(deltadays)
  
  totalHospital <- numeric(max(deltadays)+1)
  hospitaldates <-  rep(startDate,length(totalHospital))
  totalHospital[1] <- tb[1];
  currendelta <- 2
  i <- 2
  for ( i in 2:length(totalHospital))
  {
    totalHospital[i] <- totalHospital[i - 1]
    hospitaldates[i] <- hospitaldates[i] + i-1
    if (i == (as.numeric(names(tb)[currendelta])+1))
    {
      totalHospital[i] <- totalHospital[i] + tb[currendelta]
      currendelta <- currendelta + 1;
    }
  }
  print(max(totalHospital))
  lasttwoweeks[ID] <- 100000*(totalHospital[length(totalHospital)]-totalHospital[length(totalHospital)-14])/as.numeric(PoblacionMexico[ID,"X2020.Total"]);
  peakRange[[ID]] <- plotCovid(totalHospital,
                                "Hospitalización",
                                paste("Hospitalización en",statename),
                                expectedHospital,startDate,currentdate)
}

names(lasttwoweeks) <- PoblacionMexico[,"Estados.Unidos.Mexicanos"]

Ploting the hospital peaks

par(mfrow=c(1,1),cex=0.65,mar=c(6,4,4,5))

colorbar <- rep("orange",32);
colorbar[lasttwoweeks >= 10] <- "red"
colorbar[lasttwoweeks < 2] <- "green"


alldates <- peakRange[[1]]$daysRange
alldatesPeak <- peakRange[[1]]$daysRange[2];
allpeaksNumber <- peakRange[[1]]$peak
statenames <- peakRange[[1]]$name;
txtloc <- allpeaksNumber;
for (i in 2:32)
{
  alldates <- c(alldates,peakRange[[i]]$daysRange)
  alldatesPeak <- c(alldatesPeak,peakRange[[i]]$daysRange[2])
  allpeaksNumber <- c(allpeaksNumber,peakRange[[i]]$peak)
  statenames <- c(statenames,peakRange[[i]]$name)
  txtloc <- c(txtloc,peakRange[[i]]$peak + 10.0 - 7*(i %% 3))
}
alldates <- unique(alldates)
midate <- min(alldates)
dateRange <- alldates-midate
plot(alldatesPeak,allpeaksNumber,xlim=c(min(alldates),min(alldates)+180),ylim=c(0,min(400,max(allpeaksNumber))+15),main="Estimación de Picos",ylab="Pacientes Hospitalizados",xlab="Fecha del Pico",col=colorbar)
text(alldatesPeak,txtloc,PoblacionMexico[,"Estados.Unidos.Mexicanos"],cex=0.45)
abline(v=hcurrentdate,col="pink",lty=2)
legend("topright",
           legend = c("Ultima Observacion","Alto","Medio","Bajo"),
           col = c("pink","red","orange","green"),
           lty = c(2,NA,NA,NA),
           lwd = c(1,1,1,1),
          pch= c(NA,1,1,1),
           cex=0.5)




lasttwoweeks <- lasttwoweeks[order(-lasttwoweeks)]
colorbar <- rep("yellow",32);
colorbar[lasttwoweeks >= 10] <- "red"
colorbar[lasttwoweeks < 2] <- "green"

barplot(lasttwoweeks,col=colorbar,las=2,cex.axis = 1.0,cex.names = 0.45,main="Hospitalizados en las últimas dos semanas",ylab="Hospitalizados por Cada 100,000 Habitantes")

Analisis los pacientes diagnosticados con COVID-19 y muertos por regíon

ID = 19
par(mfrow=c(2,2),cex=0.45,mar=c(6,4,4,5))
peakRange <- list();
lasttwoweeks <- numeric(32);
for (ID in 1:32)
{
  
  expectedHospital <- as.numeric(PoblacionMexico[ID,"X2020.Total"])*factorHospital;
  statename <- PoblacionMexico[ID,"Estados.Unidos.Mexicanos"]

  table(COVID19MEXICO$RESULTADO,COVID19MEXICO$FECHA_DEF != "9999-99-99")
  hospitalCovidPatient <- subset(COVID19MEXICO, RESULTADO == 1 & TIPO_PACIENTE == 2 & ENTIDAD_NAC == ID)
  totalHospital <- nrow(hospitalCovidPatient);
  
  fatalityCovidPatient <- subset(COVID19MEXICO, RESULTADO==1 & FECHA_DEF != "9999-99-99" & ENTIDAD_NAC == ID)
  dateofEvent <- as.Date(fatalityCovidPatient$FECHA_DEF)

  startDate <- min(dateofEvent)
  currentdate <- max(dateofEvent)
  
  deltadays <- dateofEvent-startDate
  tb <- table(deltadays)
  
    totaldeath <- numeric(max(deltadays)+1)
    fatalitiesdates <-  rep(startDate,length(totaldeath))
    totaldeath[1] <- tb[1];
    currendelta <- 2
    for ( i in 2:length(totaldeath))
    {
      totaldeath[i] <- totaldeath[i - 1]
      if (i == (as.numeric(names(tb)[currendelta])+1))
      {
        totaldeath[i] <- totaldeath[i] + tb[currendelta]
        fatalitiesdates[i] <- fatalitiesdates[i] + i-1
        currendelta <- currendelta + 1;
      }
    }
  lasttwoweeks[ID] <- 100000*(totaldeath[length(totaldeath)]-totaldeath[length(totaldeath)-14])/as.numeric(PoblacionMexico[ID,"X2020.Total"]);

  expectedFatalities <- expectedHospital*max(totaldeath)/totalHospital;
  peakRange[[ID]] <- plotCovid(totaldeath,
                                "Defunciones",
                                paste("Defunciones en",statename),
                                expectedFatalities,startDate,currentdate)
}

names(lasttwoweeks) <- PoblacionMexico[,"Estados.Unidos.Mexicanos"]

Ploting the Fatalities peaks

par(mfrow=c(1,1),cex=0.65,mar=c(6,4,4,5))

colorbar <- rep("orange",32);
colorbar[lasttwoweeks >= 5] <- "red"
colorbar[lasttwoweeks < 1] <- "green"


alldates <- peakRange[[1]]$daysRange
alldatesPeak <- peakRange[[1]]$daysRange[2];
allpeaksNumber <- peakRange[[1]]$peak
statenames <- peakRange[[1]]$name;
txtloc <- allpeaksNumber;
for (i in 2:32)
{
  alldates <- c(alldates,peakRange[[i]]$daysRange)
  alldatesPeak <- c(alldatesPeak,peakRange[[i]]$daysRange[2])
  allpeaksNumber <- c(allpeaksNumber,peakRange[[i]]$peak)
  statenames <- c(statenames,peakRange[[i]]$name)
  txtloc <- c(txtloc,peakRange[[i]]$peak + 10.0 - 7*(i %% 3))
}
alldates <- unique(alldates)
midate <- min(alldates)
dateRange <- alldates-midate
plot(alldatesPeak,allpeaksNumber,xlim=c(min(alldates),min(alldates)+180),ylim=c(0,min(200,max(allpeaksNumber))+15),main="Estimación de Picos",ylab="Defunciones",xlab="Fecha del Pico",col=colorbar)
text(alldatesPeak,txtloc,PoblacionMexico[,"Estados.Unidos.Mexicanos"],cex=0.45)
abline(v=hcurrentdate,col="pink",lty=2)
legend("topright",
           legend = c("Ultima Observacion","Alto","Medio","Bajo"),
           col = c("pink","red","orange","green"),
           lty = c(2,NA,NA,NA),
           lwd = c(1,1,1,1),
          pch= c(NA,1,1,1),
           cex=0.5)




lasttwoweeks <- lasttwoweeks[order(-lasttwoweeks)]
colorbar <- rep("yellow",32);
colorbar[lasttwoweeks >= 5] <- "red"
colorbar[lasttwoweeks < 1] <- "green"

barplot(lasttwoweeks,col=colorbar,las=2,cex.axis = 1.0,cex.names = 0.45,main="Defunciones en las últimas dos semanas",ylab="Defunciones por Cada 100,000 Habitantes")