Untitled
Jhonathan Corrrea - Camilo Rojas
2024-10-19
ACA 03 Caso Covid II:
Al igual1 que el resto del mundo, la economía colombiana enfrenta uno de los choques más fuertes como consecuencia de la pandemia del Covid-19. Luego de un buen desempeño en 2019, que la llevó a alcanzar una tasa de crecimiento del 3,3%, frente al 0,1% de América Latina y el Caribe (Cepal, 2020), se esperaba que Colombia en 2020 alcanzara un crecimiento económico cercano al 3,5%. Sin embargo, el primer trimestre del año termina enfrentando dos choques que afectarán la economía mundial en el corto y mediano plazo: la propagación del Covid-19 y la fuerte caída del precio internacional del petróleo.
De acuerdo a la data presentada en el ACA03 se presentan los resultados en RStudio conforme al procesamiento de la totalidad de la data de la COVID 19
1. Traer las librerias que se requieren para el proceso
library(tidyverse)
library(ggplot2)
library(dplyr)2. Se carga la base de datos del covid19 para el analisis del punto
covid19 <- read_csv("C:/Users/pocho/Desktop/ACA03 TOMA/Casos_positivos_de_COVID-19_Colombia.csv")
head(covid19)## # A tibble: 6 × 8
## `ID de caso` Departamento Municipio Edad Sexo `Tipo de contagio`
## <dbl> <chr> <chr> <dbl> <chr> <chr>
## 1 1556979 VALLE CALI 67 F COMUNITARIA
## 2 1556980 VALLE CALI 66 F COMUNITARIA
## 3 1556981 VALLE CALI 68 F COMUNITARIA
## 4 1556982 VALLE CALI 74 F COMUNITARIA
## 5 1556983 VALLE CALI 65 F COMUNITARIA
## 6 1556984 VALLE CALI 66 F COMUNITARIA
## # ℹ 2 more variables: `Ubicación del caso` <chr>, Recuperado <chr>3. Exploración de los datos iniciales
colnames(covid19)## [1] "ID de caso" "Departamento" "Municipio"
## [4] "Edad" "Sexo" "Tipo de contagio"
## [7] "Ubicación del caso" "Recuperado"En esta caso validamos que los atributos que contamos en la data covid19 estan: ID de caso, Departamento, Municipio, Edad, Sexo, Tipo de contagio, Ubicación del caso y Recuperado
glimpse(covid19)## Rows: 1,682,470
## Columns: 8
## $ `ID de caso` <dbl> 1556979, 1556980, 1556981, 1556982, 1556983, 1556…
## $ Departamento <chr> "VALLE", "VALLE", "VALLE", "VALLE", "VALLE", "VAL…
## $ Municipio <chr> "CALI", "CALI", "CALI", "CALI", "CALI", "CALI", "…
## $ Edad <dbl> 67, 66, 68, 74, 65, 66, 74, 66, 64, 65, 62, 36, 3…
## $ Sexo <chr> "F", "F", "F", "F", "F", "F", "F", "F", "F", "F",…
## $ `Tipo de contagio` <chr> "COMUNITARIA", "COMUNITARIA", "COMUNITARIA", "COM…
## $ `Ubicación del caso` <chr> "CASA", "CASA", "CASA", "FALLECIDO", "CASA", "CAS…
## $ Recuperado <chr> "RECUPERADO", "RECUPERADO", "RECUPERADO", "FALLEC…Con la anterior informacion encontramos que hay 1,682,470 filas y 8 colunmas
A continuacion con la funcion summary hataremos caracteristicas de los datos:
summary(covid19)## ID de caso Departamento Municipio Edad
## Min. : 415 Length:1682470 Length:1682470 Min. : 1.00
## 1st Qu.:1331235 Class :character Class :character 1st Qu.: 27.00
## Median :2691168 Mode :character Mode :character Median : 38.00
## Mean :2313052 Mean : 39.82
## 3rd Qu.:3235707 3rd Qu.: 52.00
## Max. :4908199 Max. :114.00
## Sexo Tipo de contagio Ubicación del caso Recuperado
## Length:1682470 Length:1682470 Length:1682470 Length:1682470
## Class :character Class :character Class :character Class :character
## Mode :character Mode :character Mode :character Mode :character
##
##
## Por lo anterior, podemos evidenciar que el dato numerico \(Edad\) tiene su valor minimo en 1 año de edad, el promedio de las edades estan en 39.82 años de edad y su valor maximo 114 años.
Presentaremos la información anterior en una tabla para estudiar esta variable de la edad con respecto al sexo
covid19 %>%
group_by(Sexo) %>%
summarize(mea_edad = mean(Edad),
max_edad = max(Edad),
min_edad = min(Edad),
sd_edad = sd(Edad))## # A tibble: 2 × 5
## Sexo mea_edad max_edad min_edad sd_edad
## <chr> <dbl> <dbl> <dbl> <dbl>
## 1 F 40.0 112 1 17.9
## 2 M 39.6 114 1 17.8Los datos presentan mucha similitud entre hombres y mujeres y se puede mostrar en el siguiente grafico de cajas, donde se muestra claramente la simulitud de los datos independiente del sexom tanto para su promedio como para sus datos atipicos en el extremo superior.
ggplot(data = covid19) +
geom_boxplot(mapping = aes(x= Sexo, y = Edad))
#### 3. Creacion y Exploración de la nueva data
Bajo estos analisis iniciales es necesario depurar la data y solo dejar los atributos mas importantes para poder trabajar como lo son: Departamento, Edad, Sexo, Tipo de contagio, Ubicación del caso y Recuperado
datacovid19 <- covid19 %>%
select(Departamento, Edad, Sexo, `Tipo de contagio`,
`Ubicación del caso`, Recuperado)
head(datacovid19)## # A tibble: 6 × 6
## Departamento Edad Sexo `Tipo de contagio` `Ubicación del caso` Recuperado
## <chr> <dbl> <chr> <chr> <chr> <chr>
## 1 VALLE 67 F COMUNITARIA CASA RECUPERADO
## 2 VALLE 66 F COMUNITARIA CASA RECUPERADO
## 3 VALLE 68 F COMUNITARIA CASA RECUPERADO
## 4 VALLE 74 F COMUNITARIA FALLECIDO FALLECIDO
## 5 VALLE 65 F COMUNITARIA CASA RECUPERADO
## 6 VALLE 66 F COMUNITARIA CASA RECUPERADOSe creara un grafico para poder evidenciar los casos por departamento, en el cual Bogota, Antioquia y Valle tiene la mayor cantidad de datos con respecto a la data nacionañ
ggplot(data = datacovid19) +
geom_bar(mapping = aes(x = Departamento)) +
theme(axis.text.x = element_text(angle = 90,size = 8))
Ahora para realizar un modelo predictivo sobre regresion logistica para el contagio de un hombre o una mujer analizaremos cada item de la data
colnames(datacovid19)[c(4,5)] <- c("Tipo_de_contagio",
"Ubicacion_del_caso")
#Resumen de Tipo_de_contagio
datacovid19 %>%
group_by(Tipo_de_contagio) %>%
summarize(recuento = n())## # A tibble: 3 × 2
## Tipo_de_contagio recuento
## <chr> <int>
## 1 COMUNITARIA 1087887
## 2 IMportado 563
## 3 RELACIONADO 594020#Resumen de Ubicacion_del_caso
datacovid19 %>%
group_by(Ubicacion_del_caso) %>%
summarize(recuento = n())## # A tibble: 3 × 2
## Ubicacion_del_caso recuento
## <chr> <int>
## 1 CASA 1628215
## 2 FALLECIDO 46582
## 3 N/A 7673#Resumen de Recuperado
datacovid19 %>%
group_by(Recuperado) %>%
summarize(recuento = n())## # A tibble: 3 × 2
## Recuperado recuento
## <chr> <int>
## 1 FALLECIDO 46582
## 2 N/A 6291
## 3 RECUPERADO 16295975. Modelo regresión logística múltiple
Com sl siguiente algoritmo se intena predecir el Sexo del contagiado utilizando como variables independientes: Edad, Tipo de contagio, Ubicación del caso, y Recuperado
Lo primero que debemos hacer es realizar la codificación de las variables categóricas
datacovid19$Tipo_de_contagio <- as.numeric(factor(datacovid19$Tipo_de_contagio))
datacovid19$Ubicacion_del_caso <- as.numeric(factor(datacovid19$Ubicacion_del_caso))
datacovid19$Recuperado <- as.numeric(factor(datacovid19$Recuperado))
head(datacovid19)## # A tibble: 6 × 6
## Departamento Edad Sexo Tipo_de_contagio Ubicacion_del_caso Recuperado
## <chr> <dbl> <chr> <dbl> <dbl> <dbl>
## 1 VALLE 67 F 1 1 3
## 2 VALLE 66 F 1 1 3
## 3 VALLE 68 F 1 1 3
## 4 VALLE 74 F 1 2 1
## 5 VALLE 65 F 1 1 3
## 6 VALLE 66 F 1 1 3Validando lo anterior podemos afirmar que la transformacion hizo los siguientes cambios:
Tipo_de_contagio COMUNITARIA es 1, IMportado es 2 y RELACIONADO es 3
Ubicacion_del_caso CASA es 1, FALLECIDO es 2 y N/A es 3
Recuperado FALLECIDO es 1, N/A es 2 y RECUPERADO es 3
#Resumen de Tipo_de_contagio
datacovid19 %>%
group_by(Tipo_de_contagio) %>%
summarize(recuento = n())## # A tibble: 3 × 2
## Tipo_de_contagio recuento
## <dbl> <int>
## 1 1 1087887
## 2 2 563
## 3 3 594020#Resumen de Ubicacion_del_caso
datacovid19 %>%
group_by(Ubicacion_del_caso) %>%
summarize(recuento = n())## # A tibble: 3 × 2
## Ubicacion_del_caso recuento
## <dbl> <int>
## 1 1 1628215
## 2 2 46582
## 3 3 7673#Resumen de Recuperado
datacovid19 %>%
group_by(Recuperado) %>%
summarize(recuento = n())## # A tibble: 3 × 2
## Recuperado recuento
## <dbl> <int>
## 1 1 46582
## 2 2 6291
## 3 3 1629597Ahora se debe codificar la variable dependiente de manera binaria, 1 para M y 0 para F
datacovid19$Sexo <- ifelse(datacovid19$Sexo == "M", 1, 0)
table(datacovid19$Sexo)##
## 0 1
## 883164 799306modelo_logistico <- glm(Sexo ~ Edad + Tipo_de_contagio + Ubicacion_del_caso + Recuperado,data = datacovid19, family = binomial)
summary(modelo_logistico)##
## Call:
## glm(formula = Sexo ~ Edad + Tipo_de_contagio + Ubicacion_del_caso +
## Recuperado, family = binomial, data = datacovid19)
##
## Deviance Residuals:
## Min 1Q Median 3Q Max
## -1.446 -1.132 -1.091 1.221 1.326
##
## Coefficients:
## Estimate Std. Error z value Pr(>|z|)
## (Intercept) 6.485e-01 4.136e-02 15.678 < 2e-16 ***
## Edad -2.883e-03 9.014e-05 -31.983 < 2e-16 ***
## Tipo_de_contagio -9.444e-03 1.620e-03 -5.831 5.51e-09 ***
## Ubicacion_del_caso 1.125e-01 1.458e-02 7.717 1.19e-14 ***
## Recuperado -2.496e-01 9.300e-03 -26.837 < 2e-16 ***
## ---
## Signif. codes: 0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
##
## (Dispersion parameter for binomial family taken to be 1)
##
## Null deviance: 2328217 on 1682469 degrees of freedom
## Residual deviance: 2323769 on 1682465 degrees of freedom
## AIC: 2323779
##
## Number of Fisher Scoring iterations: 3probabilidades <- predict(modelo_logistico, type = "response")
predicciones <- ifelse(probabilidades > 0.5, 1, 0)
tabla_confusion <- table(datacovid19$Sexo, predicciones)
print(tabla_confusion)## predicciones
## 0 1
## 0 861489 21675
## 1 767133 321736. Conclusiones del modelo
Segun la matriz de confusion se puede concluir lo siguiente:
0 10 861489 21675 1 767133 32173
861,489 son mujeres correctamente clasificadas como mujeres. 32,173 son hombres correctamente clasificados como hombres. 767,133 son hombres mal clasificados como mujeres. 21,675 son mujeres mal clasificadas como hombres.
Es decir, modelo está teniendo problemas para clasificar correctamente los hombres, ya que tiene un alto número de falsos negativos (hombres clasificados como mujeres). Esto puede indicar un desbalance en los dato.
Validando nuestra data encontramos que 883164 personas son mujeres y 799306 son hombres
datacovid19 %>%
group_by(Sexo) %>%
summarize(recuento = n())## # A tibble: 2 × 2
## Sexo recuento
## <dbl> <int>
## 1 0 883164
## 2 1 799306Esta diferencia de \(883164 Mujeres - 799306 Hombres\) da un total de \(83.858\) mujeres mas que los hombres, lo que genera el desequilibrio y afecta la capacidad predictiva del modelo para identificar hombres correctamente.