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 .
  3. El 20% de los que son expuestos se contagian con el virus
  4. El 60% tiene síntomas
  5. De este 60% solamente el 10% 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 4/01/2020 Se actualizó el código de ajuste de curvas para un mejor modelo del rebrote. Ahora se toman en cuenta el último cuarto de datos para el ajuste

Nota 12/10/2020 se cambío el porcentaje de hospitalización de 20% a 30%

Nota 10/20/2020 se cambío el porcentaje de contagio de 10% a 20%

Nota 9/14/2020 Se estima la fecha que se alcanzara un caso activo por cada 100 habitantes. Además ahora utilizamos toda la población de México. Se cambío el porcetaje de hozpitalización de 15% a 20%

Nota 9/8/2020 Se añaden a los hospitalizados los muertos no hospitalizados. Además se reporta una estimación del número de casos activos por cada mil habitantes.

Nota 8/7/2020 El modelo de la curva ahora incluye dos modelos logisticos que se mezclan para dar la predicción final.

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/210903COVID19MEXICO.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')


table(COVID19MEXICO$CLASIFICACION_FINAL,COVID19MEXICO$FECHA_DEF == "9999-99-99")
#>    
#>       FALSE    TRUE
#>   1    7964  203813
#>   2   14057       0
#>   3  240200 2939260
#>   4     295   10956
#>   5    1965   75119
#>   6   10835  396347
#>   7   61287 5935813
COVID19MEXICO$RESULTADO <- 1*(COVID19MEXICO$CLASIFICACION_FINAL < 4)
table(COVID19MEXICO$RESULTADO,COVID19MEXICO$FECHA_DEF == "9999-99-99")
#>    
#>       FALSE    TRUE
#>   0   74382 6418235
#>   1  262221 3143073

COVID19MEXICO <- subset(COVID19MEXICO, EDAD > 60)

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 
#>  18619 222673 256857
table(COVID19MEXICO[COVID19MEXICO$RESULTADO==1,"FECHA_DEF"] != "9999-99-99" )
#> 
#>  FALSE   TRUE 
#> 345131 154805
table(COVID19MEXICO[COVID19MEXICO$RESULTADO==1,"TIPO_PACIENTE"] )
#> 
#>      1      2 
#> 256857 243079

PoblacionMexico$X2020.Total <- as.numeric(PoblacionMexico$X2020.Total)*0.12

totalPopulation <- sum(as.numeric(PoblacionMexico$X2020.Total))
factorHospital <- 0.70*0.20*0.60*0.30;
activosfactor <- 0.70/factorHospital;
expectedHospital <- totalPopulation*factorHospital;

Analisis los pacientes diagnosticados con COVID-19 y hospitalizados o muertos

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

hospitalCovidPatient <- subset(COVID19MEXICO, RESULTADO == 1 & (TIPO_PACIENTE == 2 | FECHA_DEF != "9999-99-99"))
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;
  }
}


ptdata <- plotCovid(totalHospital,"Hospitalización o Muerte","Hospitalización o Muerte en México (>60)",expectedHospital,startDate,currentdate)


lastobs <- length(totalHospital);
#maxplotdata <- length(ptdata$medianPred);
#lessthan1per1000 <- maxplotdata;
#totactive1000 <- numeric();
#for (dt in lastobs:maxplotdata)
#{
#  totactive1000 <- c(totactive1000,1000*sum(ptdata$medianPred[(dt-14):dt])*expectedHospital/(0.10*0.20*0.15)/totalPopulation);
#}
#Ccurrentdate <- currentdate
#names(totactive1000) <- as.character(currentdate + 1:(maxplotdata-lastobs+1))
#plot(totactive1000[1:250] ~ as.Date(currentdate + 1:250),ylim=c(0,max(totactive1000[1:250])),main="Casos Activos por cada 1000 habitantes",ylab="Activos",xlab="Fecha",las=2)
#axis(1, as.Date(seq(currentdate,currentdate+160,30)), font=2)
#totactive1000[totactive1000 >= 10]=0;
#idx <- which.max(totactive1000);
#abline(v=currentdate + idx,col="red")
#text(currentdate + idx,15,pos=4,paste("Fecha de 1 caso por cada 100 habitantes:",as.character(currentdate+idx)),cex=0.5)

Analysis de defunciones debidas a COVID-19

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

table(COVID19MEXICO$FECHA_DEF=="9999-99-99",COVID19MEXICO$RESULTADO)

fatalityCovidPatient <- subset(COVID19MEXICO, (RESULTADO==1 | RESULTADO==4) & 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)
pc <- plotCovid(totaldeath,"Defunciones","Defunciones en México (>60)",expectedFatalities,startDate,currentdate)

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

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

  hospitalCovidPatient <- subset(COVID19MEXICO, RESULTADO == 1 & (TIPO_PACIENTE == 2 | FECHA_DEF != "9999-99-99") & 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 o Muerte (>60)",
                                paste("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;
activeCases <- peakRange[[1]]$medianPred 
maxplotdata <- length(activeCases);
lessthan1per1000 <- maxplotdata;
totactive1000 <- numeric();
for (dt in lastobs:maxplotdata)
{
  totactive1000 <- c(totactive1000,1000*mean(activeCases[(dt-14):dt])*activosfactor);
}
peakRange[[1]]$lastNew
currentActivos <- 1000*peakRange[[1]]$lastNew*activosfactor;
totactive1000[totactive1000 > 10]=0;
idx <- which.max(totactive1000);
less100Date <-  currentdate + idx;



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))
#  activeCases <- peakRange[[i]]$medianPred;
  maxplotdata <- length(activeCases);
  lessthan1per1000 <- maxplotdata;
  totactive1000 <- numeric();
#  for (dt in lastobs:maxplotdata)
#  {
#    totactive1000 <- c(totactive1000,1000*mean(activeCases[(dt-14):dt])*activosfactor);
#  }
  currentActivos <- c(currentActivos,1000*peakRange[[i]]$lastNew*activosfactor)
  totactive1000[totactive1000 > 10]=0;
  idx <- which.max(totactive1000);
#  less100Date <-  c(less100Date,Ccurrentdate + idx);
}
names(currentActivos) <- PoblacionMexico[,"Estados.Unidos.Mexicanos"]

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 o Muertos",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)

#plot(currentActivos,less100Date,ylim=c(Ccurrentdate-1,Ccurrentdate+200),
#     xlim=c(0,100),
#     yaxt="none",
#     main="¿Cuándo se terminará el alto riesgo? (1 caso activo por 100 habitantes)",
#     xlab=paste("Casos activos por cada 1000 habitantes al:",as.character(Ccurrentdate)),
#     ylab="Día del Evento a Bajo Riesgo",
#     sub="Estimación basada en los datos públicos y reportados por la Secretaría de Salud, México",
#     type="n")
#text(currentActivos,less100Date,PoblacionMexico[,"Estados.Unidos.Mexicanos"],cex=0.75)
#dateAxis <- seq(Ccurrentdate-1,Ccurrentdate+200,7)
#axis(2,at=dateAxis,labels=dateAxis,las=2,cex.axis=0.45)

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 (>60) en las últimas dos semanas",ylab="Hospitalizados por Cada 100,000 Habitantes")


#currentActivos <- currentActivos[order(-currentActivos)]
#colorbar <- rep("yellow",32);
#colorbar[currentActivos >= 25] <- "red"
#colorbar[currentActivos < 10] <- "green"

#barplot(currentActivos,col=colorbar,las=2,cex.axis = 1.0,cex.names = 0.65,main="Estimacion de Casos Activos",ylab="Casos Activos #por Cada 1,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, FECHA_DEF != "9999-99-99" & ENTIDAD_NAC == ID)
    
  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 (>60)",
                                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 (>60) en las últimas dos semanas",ylab="Defunciones por Cada 100,000 Habitantes")